Edit Missing Values Using Find Loop For Set Ranges And Output To Msgbox

[B-Man]

I use a loop formula to find the missing numbers in the sequence and output the data to a msgbox.

Sub MissingNumbers()
    Dim A As Variant
    Dim i As Long, o As Long
    Dim s As String
    Dim r As Range
   
Application.ScreenUpdating = False

        Range("Summary").Select
        Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        ActiveWorkbook.Sheets("summary").Select
   
    Set r = ActiveSheet.Range("A3")     '   <<<<<<<<<<<<<<<<<<<<<<<<< change
    Set r = Range(r, r.End(xlDown))
   
    A = Application.WorksheetFunction.Transpose(r.Value)


    i = A(LBound(A))
    o = 1


    Do While i < A(UBound(A))
       
        If A(o) <> i Then
            s = s & i & ","
        Else
            Do While A(o) = A(o + 1) And i < A(UBound(A))
                o = o + 1
            Loop
           
            o = o + 1
        End If
       
        i = i + 1
   
    Loop
   
    s = Left(s, Len(s) - 1)
   
ActiveWorkbook.Close
Application.ScreenUpdating = True
    MsgBox s
End Sub

it works great for that sheet except if there isn't anything missing then it errors with a "runtime error 5" and the numbers have to be in sequence.... which they are...



id like to do the same thing for another sheet but with multiple ranges over multiple columns. and the numbers aren't in sequence..
I found this formula and it works but it prompts me for stuff and I cant work out how to automate it instead...

I have put notes into the vba code itself but basically
rather than prompt for input range use B7:B500,F7:F500,J7:J500,N7:N500,R7:R500,V7:V500,VZ7:Z500 (or find the last row of each of the columns... as they all differ, I figured 500 is a good future proofing number)
and output missing numbers to a msgbox rather than cells.

im manually running the formula on the sheet until I get it working then will implement it into the rest of my code.

Option Explicit
'**********************************************************
' Find missing integer values in a range
' Author : Philip Treacy, MyOnlineTrainingHub
' For more info go to https://www.MyOnlineTrainingHub.com/finding-missing-numbers-in-a-range-using-vba
'**********************************************************
Sub FindMissingvalues()
    
    Dim InputRange As Range, OutputRange As Range, ValueFound As Range
    Dim LowerVal As Double, UpperVal As Double, count_i As Double, count_j As Double
    Dim NumRows As Long, NumColumns As Long
    Dim Horizontal As Boolean
    
    'Default is to output the results into a column
    Horizontal = False
        
    On Error GoTo ErrorHandler
    
    'Ask for the range to check                                                                                       'would like this to use these ranges     B7:B500,F7:F500,J7:J500,N7:N500,R7:R500,V7:V500,VZ7:Z500
    Set InputRange = Application.InputBox(Prompt:="Select a range to check :", _
        Title:="Find missing values", _
        Default:=Selection.Address, Type:=8)
    
        
    'Find the lowest and highest values in the range/sequence
    LowerVal = 26                                                                                                  'i have edited this as i dont want it to look for numbers under 26
    UpperVal = WorksheetFunction.max(InputRange)
    
        
    'Ask where the output is to go                                                                                                                          'would like it to output to msgbox rather than a cell.   
    Set OutputRange = Application.InputBox(Prompt:="Select where you want the result to go :", _
        Title:="Select cell for Results", _
        Default:=Selection.Address, Type:=8)
    
    'Check the number of rows and columns in the output range
    NumRows = OutputRange.Rows.Count
    NumColumns = OutputRange.Columns.Count
    
    'If there are more columns selected than rows, output is to go horizontally
    If NumRows < NumColumns Then
    
        Horizontal = True
        'Reset the number of rows to 1 so that output is into first row
        NumRows = 1
        
    Else
    
        'Reset the number of columns to 1 so that output is into first column
        NumColumns = 1
        
    End If
    
            
    'Initalise counter and loop through sequence from lowest to highest value
    count_j = 1
    For count_i = LowerVal To UpperVal
    
        'Search for the current value (count_i)
        Set ValueFound = InputRange.Find(count_i, LookIn:=xlValues, LookAt:=xlWhole)
        
        'If it's not found, we have a missing number in the sequence
        If ValueFound Is Nothing Then
        
            'Output the missing number to the sheet
            If Horizontal Then
            
                OutputRange.Cells(NumRows, count_j).Value = count_i
                count_j = count_j + 1
            
            Else
                
                OutputRange.Cells(count_j, NumColumns).Value = count_i
                count_j = count_j + 1
            
            End If
            
        End If
        
    Next count_i
    
    Exit Sub
    
ErrorHandler:
 
    If InputRange Is Nothing Then
    
        MsgBox "ERROR : No input range specified."
        Exit Sub
        
    End If
 
    If OutputRange Is Nothing Then
    
        MsgBox "ERROR : No output cell specified."
        Exit Sub
        
    End If
    
    MsgBox "An error has occurred. The macro will end."
 
End Sub

 

[rlv01]

Possibly something like this, but I don't have any sample data to test against, so who knows...

'**********************************************************
' Find missing integer values in a range
'**********************************************************
Sub FindMissingValues()

    Dim InputRange As Range, ValueFound As Range
    Dim LowerVal As Double, UpperVal As Double, count_i As Double
    Dim NumRows As Long, NumColumns As Long
    Dim S As String

    'would like this to use these ranges - B7:B500,F7:F500,J7:J500,N7:N500,R7:R500,V7:V500,VZ7:Z500
    On Error Resume Next
    Set InputRange = Range("B7:B500,F7:F500,J7:J500,N7:N500,R7:R500,V7:V500,VZ7:Z500")
    On Error GoTo 0

    If InputRange Is Nothing Then
        MsgBox "ERROR : No input range specified."
        Exit Sub
    End If

    'Find the lowest and highest values in the range/sequence
    LowerVal = 26                                     'i have edited this as i dont want it to look for numbers under 26
    UpperVal = WorksheetFunction.Max(InputRange)

    'Initalise counter and loop through sequence from lowest to highest value
    For count_i = LowerVal To UpperVal
        'Search for the current value (count_i)
        On Error Resume Next
        Set ValueFound = InputRange.Find(count_i, LookIn:=xlValues, LookAt:=xlWhole)
        On Error GoTo 0
        
        'If it's not found, we have a missing number in the sequence
        If ValueFound Is Nothing Then
            'Output the missing number to the sheet
            S = S & count_i & ","
        Else
            Set ValueFound = Nothing
        End If
    Next count_i

    If S <> "" Then
        S = Left(S, Len(S) - 1)
    Else
        S = "no missing numbers"
    End If
    MsgBox S
End Sub

 

[B-Man]

Perfect Thanks!
I think I missed using the "" in my range which cause me an error there..... but had no idea how to turn it into a msgbox.


As I'm trying to understand the code to be self reliant
does the code below basically save the previous values assigned to S and add the new value found aswell?
eg S= "2," as 2 is missing then when it runs through the code again it is S= S (which is "2," plus the next one. so then every loop "S" keeps increasing?

  S = S & count_i & ","

and does this just remove the , at the end of S before it displays as a msgbox?

    If S <> "" Then
        S = Left(S, Len(S) - 1)

 

[rlv01]

Yes to both. If you use the VBE debugger to single step through the code, you can set a watch on variable S and see it in action.