Shopping Cart - Most commonly purchased with?

[MixedUpExcel]

Hi,

I'm struggling to come up with a simple / or not so simple solution to this question I've been asked at work.

If a customer purchases Product A - I'm trying to identify which other product (s) they most likely purchase as well.

1. I have 1000 products
2. I have 2000 orders
3. Each order basket could have various amounts of products from 1 to 100 (usually less than 30 per basket)
4. I have a list of 20 focus products
5. I want to identify what are the 5 most popular products to be purchased with each of the 20 focus products (it may also include other products from within the Focus Product Range)

I've got 3 lists.
Column A - The Order Number
Column B - The Product Code
Column C - The Focus Products

Here is a basic example in a table where ABC128 is in the Focus Product Range Column C - I've identified it in Column B, with the corresponding Order Number in Column A.
As this is just a short sample, it would show that everything in Order Number 2 is most often purchased with product ABC128 but in a much large group of orders, I'd like to identify a count against the products it's purchased with to establish a top 10.

Please can I have some suggestions on how to start to go about this?

Thanks in advance.

Simon

Order No. 1	Product Code - ABC123	ABC128
Order No. 1	Product Code - ABC124	ABC240
Order No. 1	Product Code - ABC125	ABC243
Order No. 1	Product Code - ABC126	ABC257
Order No. 2	Product Code - ABC123	ABC320
Order No. 2	Product Code - ABC128	ABC536
Order No. 2	Product Code - ABC125	ABC648
Order No. 2	Product Code - ABC130	ABC699
Order No. 2	Product Code - ABC131	ABC825
Order No. 2	Product Code - ABC133	ABC901

 

[kweaver]

What would you want as the result in your example? Should it be 6?
Would you provide another example?

It would also help if you changed your profile to indicate which version of Excel you are running.

 

[Peter_SSs]

I am assuming that column B does have the " - " before each ordered product as per your sample data. Given that, you could try this code with a copy of your workbook.

Sub OrderAnalysis()
  Dim d1 As Object, d2 As Object
  Dim a As Variant, f As Variant
  Dim i As Long, j As Long, k As Long
  
  k = 5 '<- first result column
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  f = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To UBound(f)
    d1.RemoveAll
    d2.RemoveAll
    For i = 1 To UBound(a)
      If Split(a(i, 2), " - ")(1) = f(j, 1) Then d1(a(i, 1)) = 1
    Next i
    For i = 1 To UBound(a)
      If d1.exists(a(i, 1)) Then
        If Split(a(i, 2), " - ")(1) <> f(j, 1) Then
          d2(a(i, 2)) = d2(a(i, 2)) + 1
        End If
      End If
    Next i
    If d2.Count > 0 Then
      With Cells(2, k).Resize(d2.Count, 2)
        .Value = Application.Transpose(Array(d2.Keys, d2.Items))
        .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
        .Cells(0, 1).Value = f(j, 1)
      End With
      k = k + 3
    End If
  Next j
End Sub

My sample data (I have added some more) is in columns A:C and the above code produced what you see in columns E:I

MixedUpExcel.xlsm
	A	B	C	D	E	F	G	H	I
1	Order Number	Products Ordered	Focus		ABC128			ABC257
2	Order No. 1	Product Code - ABC123	ABC128		Product Code - ABC999	2		Product Code - ABC124	1
3	Order No. 1	Product Code - ABC124	ABC240		Product Code - ABC123	1
4	Order No. 1	Product Code - ABC125	ABC243		Product Code - ABC125	1
5	Order No. 1	Product Code - ABC126	ABC257		Product Code - ABC130	1
6	Order No. 2	Product Code - ABC123	ABC320		Product Code - ABC131	1
7	Order No. 2	Product Code - ABC128	ABC536		Product Code - ABC133	1
8	Order No. 2	Product Code - ABC125	ABC648
9	Order No. 2	Product Code - ABC130	ABC699
10	Order No. 2	Product Code - ABC131	ABC825
11	Order No. 2	Product Code - ABC133	ABC901
12	Order No. 3	Product Code - ABC999
13	Order No. 3	Product Code - ABC128
14	Order No. 3	Product Code - ABC999
15	Order No. 4	Product Code - ABC128
16	Order No. 5	Product Code - ABC125
17	Order No. 6	Product Code - ABC124
18	Order No. 6	Product Code - ABC257
Sheet2

 

[MixedUpExcel]

What would you want as the result in your example? Should it be 6?
Would you provide another example?

It would also help if you changed your profile to indicate which version of Excel you are running.

Hi Kweaver,
Sorry about the slow response.
I'm using Office 365.
I think Peter has come up with pretty much what I'm looking for. I just need to test it.
Thanks for replying to my original post though.
Thanks.
Simon

 

[MixedUpExcel]

I am assuming that column B does have the " - " before each ordered product as per your sample data. Given that, you could try this code with a copy of your workbook.

Sub OrderAnalysis()
  Dim d1 As Object, d2 As Object
  Dim a As Variant, f As Variant
  Dim i As Long, j As Long, k As Long
 
  k = 5 '<- first result column
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  f = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To UBound(f)
    d1.RemoveAll
    d2.RemoveAll
    For i = 1 To UBound(a)
      If Split(a(i, 2), " - ")(1) = f(j, 1) Then d1(a(i, 1)) = 1
    Next i
    For i = 1 To UBound(a)
      If d1.exists(a(i, 1)) Then
        If Split(a(i, 2), " - ")(1) <> f(j, 1) Then
          d2(a(i, 2)) = d2(a(i, 2)) + 1
        End If
      End If
    Next i
    If d2.Count > 0 Then
      With Cells(2, k).Resize(d2.Count, 2)
        .Value = Application.Transpose(Array(d2.Keys, d2.Items))
        .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
        .Cells(0, 1).Value = f(j, 1)
      End With
      k = k + 3
    End If
  Next j
End Sub

My sample data (I have added some more) is in columns A:C and the above code produced what you see in columns E:I

Hi Peter,
Thank you for putting the code together.
When I'm back in work tomorrow, I should be able to test it but from what I can see - that pretty much looks like what I was hoping for.
I'll post back as soon as I've been able to test it.
Thank you again for your time.
Simon

 

[Peter_SSs]

I'm using Office 365.

Please add that to your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

When I'm back in work tomorrow, I should be able to test it but from what I can see - that pretty much looks like what I was hoping for.
I'll post back as soon as I've been able to test it.

OK, no problem.

 

[MixedUpExcel]

@Peter_SSs Thank you very much for the VBA Code.

I've tested it and shown my colleague who is really pleased that it does all she wants. She was originally going to do it all manually

I overcomplicated it with my sample data - for that, I apologize.

I don't fully understand the code you have put together - only some of it, so I'm not able to tweak it to how I need it.

Would it be possible for you to help me, please?

In Column B - I should have just put the product code eg. ABC123 and not Product Code - ABC123.

I've been trying to work out how I can change your code so that " - " is not needed but at this point, it's beyond me, sorry.

ps. I'm also amazed at home quickly it runs - I tested it on 54000 Rows (each with Order Number / Product Code and with a lot more in the focus and it's brilliant. Thanks.

Simon

 

[Peter_SSs]

Thanks for updating your version details.

I overcomplicated it with my sample data - for that, I apologize.

I don't fully understand the code you have put together - only some of it, so I'm not able to tweak it to how I need it.

In Column B - I should have just put the product code eg. ABC123 and not Product Code - ABC123.

I've been trying to work out how I can change your code so that " - " is not needed but at this point, it's beyond me, sorry.

That actually simplifies things a bit.

Try this version

Sub OrderAnalysis_v2()
  Dim d1 As Object, d2 As Object
  Dim a As Variant, f As Variant
  Dim i As Long, j As Long, k As Long
  
  k = 5 '<- first result column
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  a = Range("A2", Range("B" & Rows.Count).End(xlUp)).Value
  f = Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
  For j = 1 To UBound(f)
    d1.RemoveAll
    d2.RemoveAll
    For i = 1 To UBound(a)
      If a(i, 2) = f(j, 1) Then d1(a(i, 1)) = 1
    Next i
    For i = 1 To UBound(a)
      If d1.exists(a(i, 1)) Then
        If a(i, 2) <> f(j, 1) Then
          d2(a(i, 2)) = d2(a(i, 2)) + 1
        End If
      End If
    Next i
    If d2.Count > 0 Then
      With Cells(2, k).Resize(d2.Count, 2)
        .Value = Application.Transpose(Array(d2.Keys, d2.Items))
        .Sort Key1:=.Columns(2), Order1:=xlDescending, Header:=xlNo
        .Cells(0, 1).Value = f(j, 1)
      End With
      k = k + 3
    End If
  Next j
End Sub

New sample data and results.

MixedUpExcel.xlsm
	A	B	C	D	E	F	G	H	I
1	Order Number	Products Ordered	Focus		ABC128			ABC257
2	Order No. 1	ABC123	ABC128		ABC999	2		ABC124	1
3	Order No. 1	ABC124	ABC240		ABC123	1
4	Order No. 1	ABC125	ABC243		ABC125	1
5	Order No. 1	ABC126	ABC257		ABC130	1
6	Order No. 2	ABC123	ABC320		ABC131	1
7	Order No. 2	ABC128	ABC536		ABC133	1
8	Order No. 2	ABC125	ABC648
9	Order No. 2	ABC130	ABC699
10	Order No. 2	ABC131	ABC825
11	Order No. 2	ABC133	ABC901
12	Order No. 3	ABC999
13	Order No. 3	ABC128
14	Order No. 3	ABC999
15	Order No. 4	ABC128
16	Order No. 5	ABC125
17	Order No. 6	ABC124
18	Order No. 6	ABC257
Sheet3

 

[MixedUpExcel]

@Peter_SSs
Perfect. Thank you very much for amending it to work like it does.
Really appreciate your time in helping me with this and it's saved my colleague a lot of time too
Thanks.
Simon

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.