Analyse data

[mjayz]

Hi

I need to analyse many lines of data to see which products get sold together. I though a Pivot table would do the trick but having tried for a while, it doesn't seem to be the answer.

So I have a sales orders with products on them. See below. I want to know that Salt & Vinegar has sold with BBQ 4 times, while Plain and BBQ have sold together twice. In the end, I want to see which products have sold together the most.
Hope this makes sense! Thanks

<tbody>
[TD="class: xl65"]Sales Order[/TD]
[TD="class: xl65"]Product[/TD]

[TD="class: xl65"]123[/TD]
[TD="class: xl65"]Salt & Vinegar[/TD]

[TD="class: xl65"]123[/TD]
[TD="class: xl65"]Plain[/TD]

[TD="class: xl65"]123[/TD]
[TD="class: xl65"]BBQ[/TD]

[TD="class: xl65"]456[/TD]
[TD="class: xl65"]Salt & Vinegar[/TD]

[TD="class: xl65"]456[/TD]
[TD="class: xl65"]Chicken[/TD]

[TD="class: xl65"]456[/TD]
[TD="class: xl65"]BBQ[/TD]

[TD="class: xl65"]789[/TD]
[TD="class: xl65"]Salt & Vinegar[/TD]

[TD="class: xl65"]789[/TD]
[TD="class: xl65"]BBQ[/TD]

[TD="class: xl65"]124[/TD]
[TD="class: xl65"]Honey Soy[/TD]

[TD="class: xl65"]124[/TD]
[TD="class: xl65"]BBQ[/TD]

[TD="class: xl65"]124[/TD]
[TD="class: xl65"]Salt & Vinegar[/TD]

[TD="class: xl65"]124[/TD]
[TD="class: xl65"]Plain[/TD]

[TD="class: xl65"]124[/TD]
[TD="class: xl65"]Chicken[/TD]

</tbody>

 

[MickG]

Although this is a solution, depending on what you actually want, might be rather limited.!!
This code looks at each unique sales order and count any pair of "Product", to finally provide all combination pairs of all the "Products" with the total number throughout the "Sales Oder".
The results are in columns "D,E & F"
I should try this on limited data first !!!

Option Explicit
[COLOR=navy]Dim[/COLOR] Ray(), Dic [COLOR=navy]As[/COLOR] Object
[COLOR=navy]Sub[/COLOR] MG21Nov23
[COLOR=navy]Dim[/COLOR] rRng [COLOR=navy]As[/COLOR] Range, p, num [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] vElements, lRow [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] vresult [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("b2"), Range("b" & Rows.Count).End(xlUp))
[COLOR=navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        Dic(Dn.Value) = Empty
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
num = Application.Combin(Dic.Count, 2)
 ReDim Ray(1 To num + 1, 1 To 3)
  Ray(1, 1) = "Combinations": Ray(1, 2) = "Combinations": Ray(1, 3) = "Count"
  p = 2: vElements = Dic.keys
   ReDim vresult(1 To p)
    Call CombinationsNP(vElements, CInt(p), vresult, lRow + 1, 0, 1)
        num = Application.Combin(Dic.Count, 2)
        Call nFind(Ray)
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
 
[COLOR=navy]Sub[/COLOR] CombinationsNP(vElements [COLOR=navy]As[/COLOR] Variant, p [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] vresult [COLOR=navy]As[/COLOR] Variant, lRow [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] iElement [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] iIndex [COLOR=navy]As[/COLOR] Integer)
[COLOR=navy]Dim[/COLOR] i [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]For[/COLOR] i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    [COLOR=navy]If[/COLOR] iIndex = p [COLOR=navy]Then[/COLOR]
        lRow = lRow + 1
        Ray(lRow, 1) = vresult(1)
        Ray(lRow, 2) = vresult(2)
    [COLOR=navy]Else[/COLOR]
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] i
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
[COLOR=navy]Sub[/COLOR] nFind(R)
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(, 1)
    [COLOR=navy]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & ", " & Dn.Offset(, 1).Value
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]For[/COLOR] n = 2 To UBound(Ray, 1)
            [COLOR=navy]If[/COLOR] InStr(.Item(K), Ray(n, 1)) > 0 And InStr(.Item(K), Ray(n, 2)) > 0 [COLOR=navy]Then[/COLOR]
                Ray(n, 3) = Ray(n, 3) + 1
            [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Range("D1").Resize(UBound(Ray, 1), 3)
    .Value = Ray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[hiker95]

MickG,

Amazing!

Another one of your gems for my archives.

Thank you so much.

 

[hiker95]

MickG
MrExcel MVP

MickG,

Congratulations

 

[mjayz]

Thanks Mick. That is a fantastic solution and way above above my level.

As always help is greatly appreciate.
MJ

 

[MickG]

Thanks Stan !!!

#####
mjayz,
You're very welcome
Thank you for an interesting problem. !!!!

 

[hiker95]

Thanks Stan !!!

MickG, MrExcel MVP,

You are very welcome, and, again,