# Thread: Find Missing Numbers (VBA/Excel/2003)

1. ## Find Missing Numbers (VBA/Excel/2003)

This seemed so easy when my customer asked for it. He has a bunch of spreadsheets that we need to get a list of missing numbers. The sheets always have the number in column A and are in numerical order. All I need is a list of numbers that are not in the list. Here is what I have tried:

<pre>Option Explicit
Option Base 1

Sub FindMissing()
Dim NumBooks As Long, LastCurr As Long, LastNum As Long, CurBook As String
Dim A As Long, B As Long, NumRange() As Integer, C, D, E, F, G
Close #1
Open "MissingNumbs.txt" For Output As #1 'Output list
For A = 1 To Workbooks.Count 'How many workbooks
Workbooks(A).Activate
If Workbooks(A).Name = ThisWorkbook.Name Then
GoTo NextPlace 'Don't count this workbook
End If
Print #1, Workbooks(A).Name 'Add Name to list
LastCurr = Application.CountA(ActiveSheet.Range("A:A"))
LastNum = Cells(LastCurr, 1) 'Find last number to look for
ReDim NumRange(LastCurr) 'Redefine the array
For B = 1 To LastCurr
NumRange([img]/forums/images/smilies/cool.gif[/img] = Cells(B, 1) 'Fill the array with all the numbers in list
Next B
E = 1
'----------- This seemed like a good idea but is stupid ----------
For C = LBound(NumRange) To UBound(NumRange) 'Begin reading array
For D = E To LastNum 'Problem here!
If C = D Then
'nothing
Else
Print #1, C
E = D + 1
Exit For
End If
Next D
Next C
NextPlace: 'Skipped the macro book
Next 'Next workbook
Close #1 'Close the doc
MsgBox "Done" 'Ta Da
End Sub
</pre>

Perhaps someone has a better idea for me.

2. ## Re: Find Missing Numbers (VBA/Excel/2003)

Try this much shorter version. It has the added advantage of not activating the workbooks.

Sub FindMissing()
Dim LastRow As Long
Dim wbk As Workbook
Dim wsh As Worksheet
Dim i As Long
Dim j As Integer
Dim f As Integer

f = FreeFile
Open "MissingNumbs.txt" For Output As #f 'Output list

For Each wbk In Workbooks
If wbk.Name <> ThisWorkbook.Name Then
Print #f, wbk.Name 'Add Name to list
Set wsh = wbk.ActiveSheet
LastRow = wsh.Range("A65536").End(xlUp).Row
For i = 2 To LastRow
For j = wsh.Range("A" & (i - 1)) + 1 To wsh.Range("A" & i) - 1
Print #f, j
Next j
Next i
End If
Next wbk 'Next workbook

Close #f 'Close the doc
MsgBox "Done" 'Ta Da
End Sub

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•