excelvbaexcel-formulaexcel-2016

Compare a number array with existing records in Excel or VBA


I have a sheet with 3k+ lines and 15 columns. Each column is filled with a random number from 1 to 25. Very much like lottery results, where each column is a number drawn from the lottery. (from 1-25)

I need to compare whether the sequence on line 1 (for all 3k+ lines) is found in any other line. Meaning, whether the lottery results appeared twice. The catch is ball 1 can appear in any of the different 15 columns.

enter image description here

Is the an excel formula I can place in the following column? Or a VBA (ideally) code to compare?


Solution

  • Please, try the next code. It should do the job in some seconds, according to the probability to not have a match in first columns:

    Sub MatchFirstRowNumber()
     Dim ws As Worksheet, lastR As Long, rng As Range, arr
     Dim i As Long, j As Long, mtch, boolNo As Boolean
     
     Set ws = ActiveSheet
     lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
     Set rng = ws.Range("A2:O" & lastR)
     arr = rng.rows(1).Value2 'place the first row in an array
    
     For i = 2 To rng.rows.count
        boolNo = True
        For j = 1 To UBound(arr, 2)
          mtch = Application.match(arr(1, j), rng.rows(i), 0)
          If IsError(mtch) Then boolNo = False: Exit For
        Next j
        If boolNo Then MsgBox "Row """ & i + 1 & """ contains the same nubmers as the first one!", vbInformation, "A match has been found"
     Next
    End Sub
    

    As return it sends a message mentioning the matching row...

    The code can be adapted to (also) return the rows with a specific number of matches (14, for instance...).

    Or it can record the matching rows and send a message at the end, mentioning them.

    Please, send some feedback after testing it.

    Edited:

    The next version sends a single message enumerating all matches:

    Sub MatchFirstRowNumbers()
     Dim ws As Worksheet, lastR As Long, rng As Range, arr, arrRow
     Dim i As Long, j As Long, mtch, boolNo As Boolean, strMatches As String
     
     Set ws = ActiveSheet
     lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
     Set rng = ws.Range("A2:O" & lastR)
     arr = rng.rows(1).Value2 'place the first row in an array
     
     strMatches = "The next matching rows have been found:" & vbCrLf
     For i = 2 To rng.rows.count
        boolNo = True
        For j = 1 To UBound(arr, 2)
          mtch = Application.match(arr(1, j), rng.rows(i), 0)
          If IsError(mtch) Then boolNo = False: Exit For
        Next j
        If boolNo Then strMatches = strMatches & "Row " & i + 1 & vbCrLf
     Next
     If strMatches <> "The next matching rows have been found:" & vbCrLf & vbCrLf Then MsgBox strMatches, vbInformation, "All matches"
    End Sub
    

    Second Edit:

    The next version is even faster. It gets use of the fact that two arrays can be matched directly, so no iteration between the reference array elements:

    Sub MatchFirstRowNumbers()
     Dim ws As Worksheet, lastR As Long, rng As Range, arr, arrRow
     Dim i As Long, j As Long, arrMtch, boolNo As Boolean, strMatches As String
     
     Set ws = ActiveSheet
     lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
     Set rng = ws.Range("A2:O" & lastR)
     arr = rng.rows(1).Value2 'place the first row in an array
     
     strMatches = "The next matching rows have been found:" & vbCrLf
     For i = 2 To rng.rows.count
        boolNo = True
        For j = 1 To UBound(arr, 2)
          arrMtch = Application.IfError(Application.match(arr, rng.rows(i).Value, 0), "X")  'it places "|" for not matching elements
          If Not IsError(Application.match("X", arrMtch, 0)) Then boolNo = False: Exit For 'if "X" exists change boolNo value and exist For
        Next j
        If boolNo Then strMatches = strMatches & "Row " & i + 1 & vbCrLf
     Next
     If strMatches <> "The next matching rows have been found:" & vbCrLf & vbCrLf Then MsgBox strMatches, vbInformation, "All matches"
    End Sub