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.

Transaction No.	Item
10020	apple
10021	apple
10021	banana
10021	carrot
10022	apple
10022	banana
10023	lemon
10024	kiwi
10025	orange
10026	carrot
10026	banana
10026	apple

<colgroup><col><col></colgroup><tbody>
</tbody>

DESIRED RESULT:

Combination	Frequency
apple, banana	2
apple, carrot	2
apple, carrot, banana	2
banana, carrot	2
lemon	1
orange	1
kiwi	1

<colgroup><col style="text-align: center;"><col style="text-align: center;"></colgroup><tbody>
</tbody>

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 !!!!