Item Association (Frequently bought together)

[m_sabeer]

Hi,
I am looking for a code that returns the count / frequency of transactions where any two or more items are sold together for eg.

[TABLE="class: grid, width: 280"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD="align: center"]Transaction No.[/TD]
[TD="align: center"]Item[/TD]
[/TR]
[TR]
[TD="align: center"]10020[/TD]
[TD="align: center"]apple[/TD]
[/TR]
[TR]
[TD="align: center"]10021[/TD]
[TD="align: center"]apple[/TD]
[/TR]
[TR]
[TD="align: center"]10021[/TD]
[TD="align: center"]banana[/TD]
[/TR]
[TR]
[TD="align: center"]10021[/TD]
[TD="align: center"]carrot[/TD]
[/TR]
[TR]
[TD="align: center"]10022[/TD]
[TD="align: center"]apple[/TD]
[/TR]
[TR]
[TD="align: center"]10022[/TD]
[TD="align: center"]banana[/TD]
[/TR]
[TR]
[TD="align: center"]10023[/TD]
[TD="align: center"]lemon[/TD]
[/TR]
[TR]
[TD="align: center"]10024[/TD]
[TD="align: center"]kiwi[/TD]
[/TR]
[TR]
[TD="align: center"]10025[/TD]
[TD="align: center"]orange[/TD]
[/TR]
[TR]
[TD="align: center"]10026[/TD]
[TD="align: center"]carrot[/TD]
[/TR]
[TR]
[TD="align: center"]10026[/TD]
[TD="align: center"]banana[/TD]
[/TR]
[TR]
[TD="align: center"]10026[/TD]
[TD="align: center"]apple[/TD]
[/TR]
</tbody>[/TABLE]


DESIRED RESULT:

[TABLE="class: grid, width: 248"]
<colgroup><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>[TR]
[TD="align: center"]Combination[/TD]
[TD="align: center"]Frequency[/TD]
[/TR]
[TR]
[TD="align: center"]apple, banana[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]apple, carrot[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]apple, carrot, banana[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]banana, carrot[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]lemon[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]orange[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]kiwi[/TD]
[TD="align: center"]1[/TD]
[/TR]
</tbody>[/TABLE]

Thanks

 

[MickG]

Try this :-
Run code in Data sheet for results on sheet2.
NB:- See Code Notes for MultiFruit combinations

[COLOR="Navy"]Sub[/COLOR] MG23Oct04
[COLOR="Navy"]Dim[/COLOR] rRng [COLOR="Navy"]As[/COLOR] Range, n, nRay, w [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] vElements, lRow [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] vresult [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Sp1 [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, S [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] temp, K [COLOR="Navy"]As[/COLOR] Variant, P [COLOR="Navy"]As[/COLOR] Variant, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & 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
.Item(Dn.Value) = Empty
[COLOR="Navy"]Next[/COLOR] Dn
nRay = Application.Transpose(.keys)
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(nRay)
    vElements = Application.Transpose(nRay)
        ReDim vresult(1 To n)
            Call CombinationsNP(vElements, CInt(n), vresult, lRow, 1, 1)
[COLOR="Navy"]Next[/COLOR] n
.RemoveAll
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
    [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)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
n = 0
ReDim nRay(1 To Rng.Count, 1 To 2)
nRay(1, 1) = "Combination": nRay(1, 2) = "Frequency"
c = 0: n = 1
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] ray
        Num = 0
        '[COLOR="Green"][B]If InStr(R, ",") > 0 Then'>>>> Include this line for multiFruit Combinations only.[/B][/COLOR]
            Sp1 = Split(R, ",")
                [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
                    '[COLOR="Green"][B]If InStr(.Item(K), ",") > 0 Then'>>>> Include this line for multiFruit Combination only.[/B][/COLOR]
                        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] S [COLOR="Navy"]In[/COLOR] Sp1
                            [COLOR="Navy"]If[/COLOR] InStr(.Item(K), S) > 0 [COLOR="Navy"]Then[/COLOR]
                                c = c + 1
                            [COLOR="Navy"]End[/COLOR] If
                        [COLOR="Navy"]Next[/COLOR] S
                        Num = Num + IIf(c = UBound(Sp1) + 1, 1, 0): c = 0
                    '[COLOR="Green"][B]End If'>>>> Include this line for  multiFruit Combination only[/B][/COLOR]
                 [COLOR="Navy"]Next[/COLOR] K
                [COLOR="Navy"]If[/COLOR] Num > 0 [COLOR="Navy"]Then[/COLOR]
                    n = n + 1
                    nRay(n, 1) = R: nRay(n, 2) = Num
                [COLOR="Navy"]End[/COLOR] If
            '[COLOR="Green"][B]End If '>>>> Include this line for multiFruit Combinations only[/B][/COLOR]
    [COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(n, 2)
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[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
        ReDim Preserve ray(c)
        ray(c) = Join(vresult, ",")
        c = c + 1
    [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]

Regards Mick

 

[m_sabeer]

Not working

Debug: Sub CombinationsNP(vElements As Variant, P As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)

Compile error: variable not defined

 

[m_sabeer]

Not working

Debug: Sub CombinationsNP(vElements As Variant, P As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)

Compile error: Variable not defined

 

[MickG]

Sorry My fault , I forgot to copy over some variables that were declared outside the code.
Try this Example:-
NB:- This code relies on comparing all the possible combination of your data , with your actual data. If your data is only a small example of your true data the amount of possible combination would increases quite dramatically , so you will need to be aware the code may not run or take a long time to run.
I have only tested it on your example.
You will also note that the results vary slightly depending on how you define the frequency of the duplicates.

https://app.box.com/s/48tow3an9s47bnl72vk2pwoglc7t3ltu

Regrds Mick

 

[m_sabeer]

Worked well the only problem is that it takes forever to work with bigger ranges of even 100 rows :/

 

[MickG]

Yes there is a problem, but it's the Number of Fruits:-
For 6 different fruits you get 63 combinations
For 10 different fruits you get 1023 combinations
For 20 different fruits you get 1048575 combinations and so on !!!!