Raksters file has 1st set of pairs in cells R8 through R19. second set of pairs is in cells R20 through R36.
he had empty space after line 41 so I put the results in col R starting in line 42. you will need to duplicate these conditions or modify this code to suit your conditions. let me know if I can help. p8
Sub Make_comb()
' take pairs from sheet 1 yellow is 1 set white is second set split into digits make comb if 1 digit of pair
'yellow matches 1 digit in pair white
' pair data first group start line 8 col R or (18) thru line 19
'pair data 2nd group line 20 col R thru line 36
Dim l(999) ' gives me a place to store comb created and count them at same time
Range("T42:U585").Select ' clear any previous results
Selection.ClearContents
'outside loop first pairs
For x = 8 To 19 ' this is all of the group 1 pairs
pr1 = Cells(x, 18) ' take value in row 8 col R which is also 18 and easier to work with store in variable pr1
n1 = Left$(pr1, 1): n2 = Right$(pr1, 1) ' seperates the digits if pr1=09 then n1=0 n2=9
'start inner loop or 2nd pairs group
For y = 20 To 36 ' all of group 2 pairs
pr2 = Cells(y, 18)
n3 = Left$(pr2, 1): n4 = Right$(pr2, 1) ' I now have the individual digits for both pairs time to compare
If n1 = n3 Then n5 = n4: GoSub create_comb
If n1 = n4 Then n5 = n3: GoSub create_comb
If n2 = n3 Then n5 = n4: GoSub create_comb
If n2 = n4 Then n5 = n3: GoSub create_comb
Next y 'loop through 2nd pairs
Next x ' loop thru ist pairs
' display results starting row 42 col T or (20)
v = 42
For z = 0 To 999
If l(z) > 0 Then Cells(v, 20) = z: Cells(v, 21) = l(z): v = v + 1
Next z
Range("U42").Select
Selection.Sort Key1:=Range("U42"), Order1:=xlDescending
Exit Sub
create_comb: '1 digit in pair 1 matched 1 or more digits in pair 2
' check for doubles
'If n1 = n2 Or n1 = n5 Or n2 = n5 Then GoTo dblquit
m1 = n1: m2 = n2: m5 = n5
For z = 1 To 3: If m1 < m2 Then m6 = m2: m2 = m1: m1 = m6
If m2 < m5 Then m6 = m5: m5 = m2: m2 = m6
Next z ' sort the 3 digits hi to low
a = m1 * 100 + m2 * 10 + m5 ' convert digits to number 0-999
l(a) = l(a) + 1 ' keep track of comb created and count how many times it occurs
dblquit:
Return
End Sub