the vba code ,,,
Public Sub Highlight_Repetitions()
REPEATS = Application.InputBox("How many numbers would you like to find Repetitions:", Type:=1)
Dim Rw1 As Range, Rw2 As Range
Dim check_array As Variant, match_array As Variant
Range("AA2:AC20000").ClearContents
For Each Rw1 In [Numbers].Rows
check_array = Rw1.Value
For Each Rw2 In [Numbers].Rows
If Rw2.Row > Rw1.Row Then
match_array = Rw2.Value
repetitions = 0
repeat_string = vbNullString
For i = LBound(check_array, 2) To UBound(check_array, 2)
If i <= REPEATS + repetitions Then
For j = LBound(match_array, 2) To UBound(match_array, 2)
If check_array(1, i) = match_array(1, j) Then
repetitions = repetitions + 1
repeat_string = repeat_string & check_array(1, i) & " "
End If
Next
Else
Exit For
End If
Next
If repetitions >= REPEATS Then
'MsgBox "Rows " & Rw1.Row & " and " & Rw2.Row & " have repetitions"
Rw1.Cells(1, 1).Offset(, 26).Value = Rw1.Cells(1, 1).Offset(, 26).Value & "" & repeat_string & "" & ", "
Rw2.Cells(1, 1).Offset(, 26).Value = Rw2.Cells(1, 1).Offset(, 26).Value & "" & repeat_string & "" & ", "
If Rw1.Cells(1, 1).Offset(, 28).Value = vbNullString Then
Rw1.Cells(1, 1).Offset(, 28).Value = Rw2.Row
Else
Rw1.Cells(1, 1).Offset(, 28).Value = Rw1.Cells(1, 1).Offset(, 28).Value & " , " & Rw2.Row
End If
If Rw2.Cells(1, 1).Offset(, 28).Value = vbNullString Then
Rw2.Cells(1, 1).Offset(, 28).Value = Rw1.Row
Else
Rw2.Cells(1, 1).Offset(, 28).Value = Rw2.Cells(1, 1).Offset(, 28).Value & " , " & Rw1.Row
End If
End If
End If
Next
Next
End Sub