Macro or formula to match combinations with 4 or more similar number

[Flexalong]

Hey Giles,

Hope I can enlist your help again. I would like to match the combinations below...

2 4 18 19 35 43
8 24 26 45 47 49
14 15 17 29 31 32
5 20 21 30 33 44
9 12 37 50 51 52
5 10 27 39 42 48
13 17 22 23 36 46
1 3 11 16 40 41
6 7 25 28 34 38
3 8 20 23 29 43
24 27 28 37 38 44

for 4 or more similar numbers with the results below

7 13 21 28 35 42
2 8 25 32 41 51
5 6 23 29 37 43
12 25 34 38 41 43
4 16 18 22 38 43
6 28 36 44 49 50
4 11 17 32 38 50
3 19 40 41 43 49
18 19 24 25 29 39
1 6 10 48 49 50
13 14 15 37 45 50
4 8 15 17 19 26
1 12 35 37 49 51
18 20 29 41 45 48
3 5 12 14 24 32
1 4 5 10 17 42
4 7 30 31 39 42
3 21 24 25 35 45
8 12 20 29 43 52
20 33 35 37 48 50
2 13 17 26 34 36
7 10 11 26 40 44
5 19 42 48 49 50
14 19 21 32 44 48
3 8 11 30 48 49
8 18 30 31 37 39
9 17 21 23 50 52
6 12 18 43 47 52
2 9 21 29 45 50
5 18 33 35 38 44
4 6 17 41 47 49
1 3 4 20 33 50
1 6 42 44 45 51
2 22 28 47 49 52
7 8 21 30 31 38
8 9 14 27 36 39
6 12 25 31 45 47

And then indicate true or false in a column beside the combinations.

Thanks in advance

 

[GillesD]

Calculating matches between two sets

Flexalong, I first came up with the macro Match_4Plus which does what you want but I found I could improve it to provide more useful results; it is the macro named Show_4Plus.

A – Set-up of the sheet:
On the first row in cells A1:O1, place titles as you like but in cell H1, enter the formula =COUNT(B:B) and the formula =COUNT(J:J) in cell P1. This will indicate how many rows of data are in each group of data.

Then starting on the second row and going down as necessary, place the first group of numbers in columns B to G and the second group of numbers in columns J to O. I used columns A and I to put a sequential number for each set of numbers (in your example, 1 to 11 for the first group and 1 to 37 for the second group). This is optional for the first macro but necessary in the second one.

B – Code for common declarations:
In the macro module, place the following lines at the top to declare variables as Integer (this should be more than enough for both procedures):

Option Explicit
Dim Data_1() As Integer, Data_2() As Integer
Dim N1 As Integer, N2 As Integer, Nx4 As Integer, nRow As Integer
Dim I As Integer, J As Integer, K As Integer, L As Integer

C – Code for the Match_4Plus procedure
This is the listing for the first macro:

Sub Match_4Plus()
Range("A1").Select
Application.ScreenUpdating = False
N1 = Range("H1").Value
N2 = Range("P1").Value
ReDim Data_1(N1, 6), Data_2(N2, 6)
For I = 1 To N1
For J = 1 To 6
Data_1(I, J) = ActiveCell.Offset(I, J).Value
Next J
ActiveCell.Offset(I, 7).Value = ""
Next I
For I = 1 To N2
For J = 1 To 6
Data_2(I, J) = ActiveCell.Offset(I, J + 8).Value
Next J
Next I
For I = 1 To N1
For J = 1 To N2
Nx4 = 0
For K = 1 To 6
For L = 1 To 6
If Data_1(I, K) = Data_2(J, L) Then Nx4 = Nx4 + 1
Next L
Next K
If Nx4 >= 4 Then ActiveCell.Offset(I, 7).Value = True
Next J
Next I
Application.ScreenUpdating = True
End Sub

D – Output of the preceding macro
In column H, you will get a TRUE value for the where 4 or more values in columns B to G match values on a line in columns J to O. If less than 4 numbers match, it will be left blank. In your example, only the cell H11 (for set #11) will show a TRUE value.

E - Code for the improved Show_4Plus procedure
This is the listing for the second macro:

Sub Show_4Plus()
Range("A1").Select
Application.ScreenUpdating = False
N1 = Range("H1").Value
N2 = Range("P1").Value
ReDim Data_1(N1, 6), Data_2(N2, 6)
nRow = 1
Do While ActiveCell.Offset(nRow, 17).Value <> ""
ActiveCell.Offset(nRow, 17).Value = ""
ActiveCell.Offset(nRow, 18).Value = ""
ActiveCell.Offset(nRow, 19).Value = ""
nRow = nRow + 1
Loop
For I = 1 To N1
For J = 1 To 6
Data_1(I, J) = ActiveCell.Offset(I, J).Value
Next J
Next I
For I = 1 To N2
For J = 1 To 6
Data_2(I, J) = ActiveCell.Offset(I, J + 8).Value
Next J
Next I
nRow = 0
For I = 1 To N1
For J = 1 To N2
Nx4 = 0
For K = 1 To 6
For L = 1 To 6
If Data_1(I, K) = Data_2(J, L) Then Nx4 = Nx4 + 1
Next L
Next K
If Nx4 >= 4 Then
nRow = nRow + 1
ActiveCell.Offset(nRow, 17).Value = I
ActiveCell.Offset(nRow, 18).Value = J
ActiveCell.Offset(nRow, 19).Value = Nx4
End If
Next J
Next I
Application.ScreenUpdating = True
End Sub

F – Output of the preceding macro
In columns R to T, stating in row 2, when you have 4 or more matches, you will get the set number from the first group (taken from column A), then the set number from the second group (taken from column I) and finally, the number of matches between the two sets. In your example, there was a 4 number match between sets 10 and 19.

 

[Flexalong]

Great work as usual, Giles...very well explained.
Can you edit Show_4Plus() so that it shows 3 matches as well.

Thanks

 

[GillesD]

Adjustment

Can you edit Show_4Plus() so that it shows 3 matches as well.

The display in columns R-S-T is controlled by the line "If Nx4 >= 4 Then ". You just have to modify it to fit your needs.

Replacing the "4" by a "3" will display all pairs of sets with 3 or more matches. Replacing ">=4" by "=5" will display only the pairs of sets with 5 matches.

 

[bloubul]

GillesD

Brilliant as allways. Thanks

BlouBul

 

[Flexalong]

Hi GilesD,

I would like to seek your help again. Could you edit the code so that it compares 6 numbered combinations against 7 numbered combinations instead of 6. For instance compare these combinations...

3 8 9 17 25 38
12 18 32 35 41 45
2 11 15 19 23 34
10 16 27 28 33 42
5 14 26 30 36 44
6 7 13 20 22 39
4 21 24 29 40 43
14 18 19 24 28 39
13 15 21 31 36 42
1 5 17 22 29 31
25 27 34 37 41 43
1 2 3 10 32 44
7 8 12 26 33 37
4 20 23 30 35 38
6 9 11 16 40 45


with this 7 numbered combinations...

21 31 34 35 37 38 17
3 6 13 20 42 45 28
10 12 27 29 39 45 40
7 10 21 25 28 44 14
6 14 27 29 39 45 32
15 28 30 33 34 44 36
12 14 20 32 39 42 16
2 5 12 16 37 40 42
11 13 16 19 23 25 44
6 17 22 29 37 40 38
6 23 25 38 40 41 17
14 25 30 37 39 42 17
5 15 30 34 43 44 42
5 12 13 30 31 43 39
3 4 14 27 33 41 25

and look for combinations with 4 or more matches.

Thanks in advance

Flex

 

[PAB]

Hi Flex,

I just came across this old request by you.
I don't know if you managed to get it sorted or not but I thought I would post the ADAPTED code originally given by GillesD for you or anyone else interested in this.
The setup is exactly as posted by GillesD with the following amendments.
(1) MOVE the formula in P1 to Q1, you do NOT need to adjust it with the MOVE in this instance.
(2) Copy the data you posted above for the 6 number combinations in columns B:G starting in row 2.
(3) Copy the data you posted above for the 7 number combinations in columns J starting in row 2.
(4) Copy the Macro below and run.

Sub Show_4Plus_Adapted()
Dim Data_1() As Integer, Data_2() As Integer
Dim N1 As Integer, N2 As Integer, Nx4 As Integer, nRow As Integer
Dim I As Integer, J As Integer, K As Integer, L As Integer
Range("A1").Select
Application.ScreenUpdating = False
N1 = Range("H1").Value
N2 = Range("Q1").Value
ReDim Data_1(N1, 6), Data_2(N2, 7)
nRow = 1
Do While ActiveCell.Offset(nRow, 18).Value <> ""
ActiveCell.Offset(nRow, 18).Value = ""
ActiveCell.Offset(nRow, 19).Value = ""
ActiveCell.Offset(nRow, 20).Value = ""
nRow = nRow + 1
Loop
For I = 1 To N1
For J = 1 To 6
Data_1(I, J) = ActiveCell.Offset(I, J).Value
Next J
Next I
For I = 1 To N2
For J = 1 To 7
Data_2(I, J) = ActiveCell.Offset(I, J + 8).Value
Next J
Next I
nRow = 0
For I = 1 To N1
For J = 1 To N2
Nx4 = 0
For K = 1 To 6
For L = 1 To 7
If Data_1(I, K) = Data_2(J, L) Then Nx4 = Nx4 + 1
Next L
Next K
If Nx4 >= 4 Then
nRow = nRow + 1
ActiveCell.Offset(nRow, 18).Value = I
ActiveCell.Offset(nRow, 19).Value = J
ActiveCell.Offset(nRow, 20).Value = Nx4
End If
Next J
Next I
Application.ScreenUpdating = True
End Sub

I hope this is what you were after.

Regards,
PAB


-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-
12:45, restate my assumptions.
Mathematics is the language of nature.
Everything around us can be represented and understood through numbers.
If you graph the numbers of any system, patterns emerge. Therefore, there are patterns everywhere in nature.

 

[PAB]

One other point I have just thought of.
The Macro I posted above will be acceptable for small amounts of data comparison.
If you intend to use much larger two groups of numbers then the Macro could be tweaked slightly to cut down on processing time.
The Macro posted is an adaption of GillesD's second Macro.

Regards,
PAB


-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-
12:45, restate my assumptions.
Mathematics is the language of nature.
Everything around us can be represented and understood through numbers.
If you graph the numbers of any system, patterns emerge. Therefore, there are patterns everywhere in nature.

 

[PAB]

Hi Flex,

Was the Macro any good, and if so did it do what you wanted?

Regards,
PAB


-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-∏-
12:45, restate my assumptions.
Mathematics is the language of nature.
Everything around us can be represented and understood through numbers.
If you graph the numbers of any system, patterns emerge. Therefore, there are patterns everywhere in nature.