Results 1 to 2 of 2
  1. #1
    3 Star Lounger MacroAlan's Avatar
    Join Date
    Feb 2003
    St Louis, Missouri, USA
    Thanked 1 Time in 1 Post

    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
    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
    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

    Perhaps someone has a better idea for me.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Thanked 31 Times in 31 Posts

    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