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.

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

Just a toy example, but you could try something like this assuming that each row is in ascending order:

=SUM(--(MMULT(ABS(A2:C2-A$2:C$5),TRANSPOSE(COLUMN(A$2:C$5))^0)=0))

Example with no matches

If the answer is more than 1, there is a duplicate.

In Excel 2016, you might need to array-enter it or use Sumproduct.

Here's an example with a match

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

Thanks for the fun challenge! Though you have accepted an answer, I wanted to see a way to do it without VBA and with Excel 2016:

• Add a helper column with sorted and joined text, unfortunately needs to be filled-down for all the rows
  =CONCAT(TEXT(SMALL(C2:Q2, COLUMN(C2:Q2) - COLUMN($C$2) + 1), "00"))
• Another column to find duplicates, again fill-down
  =COUNTIF($S$2:$S$11, S2) > 1
• Use conditional formatting to highlight the duplicate rows (not sure whether this works in Excel 2016 - I don't have it to test); with first cell in the first row selected, enter the first cell from the step above with fixed column reference and relative row reference.
  =$T2

Designate Row Containing the Same Integers

• For each row, this will populate the R column with a comma-separated list (at least two numbers) of each row index (row of the range) containing the same 15 numbers. The resulting cell becomes empty when no 'matching' row is found,

• Unfortunately, the Count/Match combo performs very slow on such a large number of comparisons. It took nearly 4 minutes to complete the task for 3k rows to find the only set of two 'matching' rows.

• The sample data was generated using the slow but relatively easy to come up with MS365 formula:

  =DROP(REDUCE("",SEQUENCE(3000),LAMBDA(rr,r,
      VSTACK(rr,TAKE(SORTBY(SEQUENCE(,25),RANDARRAY(,25)),,15)))),1)
  

  copied and pasted as values. It can be replicated with a fast VBA macro (e.g. search for shuffle array).

Sub TestMatch()
    
    Dim t As Double: t = Timer
    
    Const COLS_COUNT As Long = 15
    Const FIRST_ROW As Long = 2
    Const FIRST_COLUMN As Long = 3
    Const COLUMN_OFFSET As Long = 1
    Const DELIMITER As String = ", "
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    Dim rCount As Long: rCount = rg.Rows.Count - 1
    
    Dim srg As Range:
    Set srg = rg.Resize(rCount, COLS_COUNT).Offset(FIRST_ROW - 1, FIRST_COLUMN - 1)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    
    For i = 1 To rCount
        dict(i) = Empty
    Next i
    
    Dim srrg As Range, drrg As Range, Count As Long, j As Long
    
    With Application
        For i = 1 To rCount - 1
            If dict.Exists(i) Then
                For j = i + 1 To rCount
                    If dict.Exists(j) Then
                        Count = .Count(.Match(srg.Rows(i), srg.Rows(j), 0))
                        If Count = COLS_COUNT Then
                            If IsEmpty(dict(i)) Then
                                Set dict(i) = CreateObject("Scripting.Dictionary")
                            End If
                            dict(i)(j) = Empty
                            dict.Remove j
                        End If
                    End If
                Next j
            End If
        Next i
    End With
                    
    If dict.Count = rCount Then Exit Sub ' no duplicate rows found
    
    Debug.Print Timer - t
    
    Dim Data() As String: ReDim Data(1 To rCount, 1 To 1)
    
    Dim oKey As Variant, iKey As Variant, rStr As String
    
    For Each oKey In dict.Keys
        If Not IsEmpty(dict(oKey)) Then
            rStr = oKey
            rStr = rStr & DELIMITER & Join(dict(oKey).Keys, DELIMITER)
            Data(oKey, 1) = rStr
            For Each iKey In dict(oKey).Keys
                Data(iKey, 1) = rStr
            Next iKey
        End If
    Next oKey
        
    Dim drg As Range:
    Set drg = srg.Columns(COLS_COUNT).Offset(, COLUMN_OFFSET)
    drg.Value = Data
        
    Debug.Print Timer - t
        
End Sub