Match frequency of grouped numbers

[dgroves1964]

I am looking for a solution in excel that will match frequent groups of numbers for only matches 3 times to the max of 6 times. Example: I have 6 columns, and an infinite number of rows, for this example only 4 are shown. Regardless of order, (2,7,4) have repeated in row 1 & 2 & 4. (2,7,4,12,3) have repeated in row 1 & 4. While (13,11) repeated in row 2 & 3 it is not of interest since it is less than 3 numbers.

A B C D E F
1 10 2 3 7 4 12
2 2 7 4 14 13 11
3 20 13 11 15 3 33
4 2 4 7 12 3 21

 

[MickG]

Try this for data starting "A2", and Results starting "H1".

[COLOR="Navy"]Sub[/COLOR] MG25Oct21
[COLOR="Navy"]Dim[/COLOR] AL [COLOR="Navy"]As[/COLOR] Object, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range
   [COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
   ReDim Ray(1 To Rng.Count, 1 To 6)
   [COLOR="Navy"]Set[/COLOR] AL = CreateObject("system.collections.arraylist")
   
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
      [COLOR="Navy"]For[/COLOR] Ac = 0 To 5
         AL.Add Dn.Offset(, Ac).Value
      [COLOR="Navy"]Next[/COLOR] Ac
      AL.Sort
      [COLOR="Navy"]For[/COLOR] Ac = 0 To 5
         Ray(Dn.Row - 1, Ac + 1) = AL(Ac)
      [COLOR="Navy"]Next[/COLOR] Ac
     AL.Clear
   [COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]Dim[/COLOR] nStr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] S [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rr [COLOR="Navy"]As[/COLOR] Variant, nRay [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] Variant

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray)
   nStr = "1,2,3,4,5,6"
    [COLOR="Navy"]For[/COLOR] S = 5 To 11 [COLOR="Navy"]Step[/COLOR] 2
        [COLOR="Navy"]For[/COLOR] Ac = 1 To 12 - S [COLOR="Navy"]Step[/COLOR] 2
            Txt = Mid(nStr, Ac, S)
                nRay = Split(Txt, ",")
                R = Application.Index(Ray, n, nRay)
                Txt = Join(R, ",")
                [COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
                    .Add Txt, 1
                [COLOR="Navy"]Else[/COLOR]
                    .Item(Txt) = .Item(Txt) + 1
                [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] Ac
    [COLOR="Navy"]Next[/COLOR] S
[COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] .Item(K) > 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1: Cells(c, "H") = K: Cells(c, "I") = .Item(K)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick