Non-consecutive numbers in Macro

[Ramona]

After not wanting to, it looks like I do need to create a
macro. How would I do the following to make sure that it
captures a range of missing numbers (1006-1008 below)? I
need to find all gaps in the Invoice # list and flag the
numbers to a new worksheet(#2), preferably all listed in
Column A without gaps.

Worksheet #1 Worksheet #2
Invoice# Customer Invoice#
1001 Acme 1003
1002 Davis 1006
1004 Shopstar 1007
1005 Walker 1008
1009 Trains

Thanks for any help.

 

[Doug Glancy]

Ramona,

This works with the active sheet and puts the results in "Sheet 2". It
assumes the invoice numbers are in column A. It's slow, so if you've got
more than a few thousand, go pour a cup of coffee:

Sub test()

Dim last_row As Long
Dim invoice_range As Range
Dim all_invoices() As String
Dim start_num As Long, last_num As Long
Dim i As Long
Dim print_row As Long

last_row = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set invoice_range = ActiveSheet.Range("A1:A" & last_row)
start_num = ActiveSheet.Range("A2")
last_num = ActiveSheet.Range("A" & last_row).Value
ReDim all_invoices(start_num To last_num)

For i = start_num To last_num
If Application.WorksheetFunction.CountIf(invoice_range, i) = 0 Then
all_invoices(i) = "missing"
End If
Next i

Worksheets("Sheet2").Cells.Clear
Worksheets("Sheet2").Range("A1").Value = "Missing Invoices"
print_row = 2

For i = start_num To last_num
If all_invoices(i) = "missing" Then
Worksheets("Sheet2").Range("A" & print_row) = i
print_row = print_row + 1
End If
Next i

End Sub
hth,

Doug Glancy

 

[Greg Wilson]

This assumes that the invoice numbers start in Cell A2 of
Sheet2 (header in A1?) and that the missing invoice
numbers are to be transferred to Sheet2 starting in the
first availble cell in Column A:

Sub FindMissingInvoiceNums()
Dim Rng As Range
Dim C1 As Range, C2 As Range
Dim x As Long
On Error Resume Next
With Sheets("Sheet1")
x = .Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = .Range(.Cells(2, 1), .Cells(x, 1))
End With
With Sheets("Sheet2")
x = .Cells(Rows.Count, 1).End(xlUp).Row
Set C2 = .Cells(x, 1)(2)
End With
x = 0
For Each C1 In Rng
If C1.Row > Rng(1).Row Then
If C1 - C1(0) > 1 Then
For x = 1 To C1 - C1(0) - 1
C2 = C1(0) + x
Set C2 = C2(2)
Next
x = 0
End If
End If
Next
On Error GoTo 0
End Sub

Regards,
Greg

 

[Greg Wilson]

Correction: Should have said "This assumes that the
invoice numbers start in Cell A2 of Sheet1 ... "

Regards,
Greg