Product Affinity, How do I find popular pairings?

[MistyWind]

I'd like to run a product affinity analysis, meaning I'd like to find out which are the most popular pairings of products customers are buying. My data is structured (shown below) with Order ID in column A and Product ID in column B. How do I identify the most popular pairings while identifying how many times each unique pair has been purchased? I'm not concerned with the quantity of items ordered in each unique order, I just need to know the pairs and the total number of them. Thanks.

Order ID	Product ID
100056	12-325
	36-125
	83-558
	45-254
100057	45-696
100058	36-125
	47-122
	78-562
100059	83-558
	33-785
	78-191
	58-538
	56-325
100060	83-558
	45-254
	36-125

 

[Eric W]

If you're open to VBA, try:

Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code in the window that opens:

Sub CountPairs()
Dim MyTab As Variant, MyDic As Object, r1 As Long, r2 As Long, k As String

    MyTab = Range("A2:B" & Range("B1").End(xlDown).Row).Value
    Set MyDic = CreateObject("Scripting.Dictionary")
    
    For r1 = 1 To UBound(MyTab)
        For r2 = r1 + 1 To UBound(MyTab)
            If MyTab(r2, 1) <> "" Then Exit For
            k = IIf(MyTab(r1, 2) > MyTab(r2, 2), MyTab(r2, 2) & " / " & MyTab(r1, 2), MyTab(r1, 2) & " / " & MyTab(r2, 2))
            MyDic(k) = MyDic(k) + 1
        Next r2
    Next r1
    
    Range("D1:E1").Value = Array("Pair", "Count")
    Range("D2").Resize(MyDic.Count).Value = WorksheetFunction.Transpose(MyDic.keys)
    Range("E2").Resize(MyDic.Count).Value = WorksheetFunction.Transpose(MyDic.items)
    
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("E2"), Order:=xlDescending
        .SetRange Range("D1:E" & MyDic.Count + 1)
        .Header = xlYes
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

This assumes that your orders and parts are in columns A:B, and the results will be displayed in columns D:E.

The results of this macro on your sample are these:

Book1
	A	B	C	D	E
1	Order ID	Product ID		Pair	Count
2	100056	12-325		36-125 / 83-558	2
3		36-125		36-125 / 45-254	2
4		83-558		45-254 / 83-558	2
5		45-254		12-325 / 36-125	1
6	100057	45-696		12-325 / 83-558	1
7	100058	36-125		12-325 / 45-254	1
8		47-122		36-125 / 47-122	1
9		78-562		36-125 / 78-562	1
10	100059	83-558		47-122 / 78-562	1
11		33-785		33-785 / 83-558	1
12		78-191		78-191 / 83-558	1
13		58-538		58-538 / 83-558	1
14		56-325		56-325 / 83-558	1
15	100060	83-558		33-785 / 78-191	1
16		45-254		33-785 / 58-538	1
17		36-125		33-785 / 56-325	1
18				58-538 / 78-191	1
19				56-325 / 78-191	1
20				56-325 / 58-538	1
Sheet1

Let us know how this works for you.

 

[MistyWind]

If you're open to VBA, try:

Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to Insert a Module. Paste the following code in the window that opens:

Sub CountPairs()
Dim MyTab As Variant, MyDic As Object, r1 As Long, r2 As Long, k As String

    MyTab = Range("A2:B" & Range("B1").End(xlDown).Row).Value
    Set MyDic = CreateObject("Scripting.Dictionary")
   
    For r1 = 1 To UBound(MyTab)
        For r2 = r1 + 1 To UBound(MyTab)
            If MyTab(r2, 1) <> "" Then Exit For
            k = IIf(MyTab(r1, 2) > MyTab(r2, 2), MyTab(r2, 2) & " / " & MyTab(r1, 2), MyTab(r1, 2) & " / " & MyTab(r2, 2))
            MyDic(k) = MyDic(k) + 1
        Next r2
    Next r1
   
    Range("D1:E1").Value = Array("Pair", "Count")
    Range("D2").Resize(MyDic.Count).Value = WorksheetFunction.Transpose(MyDic.keys)
    Range("E2").Resize(MyDic.Count).Value = WorksheetFunction.Transpose(MyDic.items)
   
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("E2"), Order:=xlDescending
        .SetRange Range("D1:E" & MyDic.Count + 1)
        .Header = xlYes
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

This assumes that your orders and parts are in columns A:B, and the results will be displayed in columns D:E.

The results of this macro on your sample are these:

Book1
	A	B	C	D	E
1	Order ID	Product ID		Pair	Count
2	100056	12-325		36-125 / 83-558	2
3		36-125		36-125 / 45-254	2
4		83-558		45-254 / 83-558	2
5		45-254		12-325 / 36-125	1
6	100057	45-696		12-325 / 83-558	1
7	100058	36-125		12-325 / 45-254	1
8		47-122		36-125 / 47-122	1
9		78-562		36-125 / 78-562	1
10	100059	83-558		47-122 / 78-562	1
11		33-785		33-785 / 83-558	1
12		78-191		78-191 / 83-558	1
13		58-538		58-538 / 83-558	1
14		56-325		56-325 / 83-558	1
15	100060	83-558		33-785 / 78-191	1
16		45-254		33-785 / 58-538	1
17		36-125		33-785 / 56-325	1
18				58-538 / 78-191	1
19				56-325 / 78-191	1
20				56-325 / 58-538	1
Sheet1

Let us know how this works for you.

Thank you for introducing me to VBA. I haven't used it before. I ran the code as instructed and ran into an error. Here's a screenshot of the debug. I don't know if the error occurred because of format differences than I provided at first. 1) different column header names 2) every line in the order column is populated 3) the product IDs have different character formatting.

Do you know why the code failed? Thanks.

 

[Eric W]

First of all, good job in figuring out how to run the macro, I see that I neglected to finish the instructions. There are a few ways to run the macro, you can press F5 from within the editor, or go back to the Excel sheet, press Alt-F8, select CountPairs, and click Run.

The probable reason you got the error is due to having all the order numbers instead of blank lines (your issue 2). My macro looked for the blank lines. To fix that, just change this line:

            If MyTab(r2, 1) <> "" Then Exit For

to

            If MyTab(r2, 1) <> MyTab(r1, 1) And MyTab(r2, 1) <> "" Then Exit For

It'll work either way now.

Another possible issue could arise based on the number of product numbers you have. How many product numbers do you have? If you have 1000 items, the number of possible pairs is 1000*999 = 999,000 which is quite a lot. So maybe instead of the whole list, you just want the top 100 pairs? Or do you think that will be an issue?

Your issues 1 and 3 probably won't cause problems. Let me know if this works for you.

 

[MistyWind]

First of all, good job in figuring out how to run the macro, I see that I neglected to finish the instructions. There are a few ways to run the macro, you can press F5 from within the editor, or go back to the Excel sheet, press Alt-F8, select CountPairs, and click Run.

The probable reason you got the error is due to having all the order numbers instead of blank lines (your issue 2). My macro looked for the blank lines. To fix that, just change this line:

            If MyTab(r2, 1) <> "" Then Exit For

to

            If MyTab(r2, 1) <> MyTab(r1, 1) And MyTab(r2, 1) <> "" Then Exit For

It'll work either way now.

Another possible issue could arise based on the number of product numbers you have. How many product numbers do you have? If you have 1000 items, the number of possible pairs is 1000*999 = 999,000 which is quite a lot. So maybe instead of the whole list, you just want the top 100 pairs? Or do you think that will be an issue?

Your issues 1 and 3 probably won't cause problems. Let me know if this works for you.

First of all, good job in figuring out how to run the macro, I see that I neglected to finish the instructions. There are a few ways to run the macro, you can press F5 from within the editor, or go back to the Excel sheet, press Alt-F8, select CountPairs, and click Run.

The probable reason you got the error is due to having all the order numbers instead of blank lines (your issue 2). My macro looked for the blank lines. To fix that, just change this line:

            If MyTab(r2, 1) <> "" Then Exit For

to

            If MyTab(r2, 1) <> MyTab(r1, 1) And MyTab(r2, 1) <> "" Then Exit For

It'll work either way now.

Another possible issue could arise based on the number of product numbers you have. How many product numbers do you have? If you have 1000 items, the number of possible pairs is 1000*999 = 999,000 which is quite a lot. So maybe instead of the whole list, you just want the top 100 pairs? Or do you think that will be an issue?

Your issues 1 and 3 probably won't cause problems. Let me know if this works for you.

Thank you so much. I didn't make any other changes except for the line of code in the macro. Worked like a charm.
FYI, I'm dealing with just under 500 unique products and over 7,000 rows of order data. Either way this worked just fine. Thank you so much for your help.

 

[Eric W]

Happy to help! Thanks for the feedback.