Returning Column and Row labels Based on cell Value

[tbollo]

Hello,

I'm trying to establish which two products are frequently bought together. I have the data in the below format:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Product(s)[/TD]
[TD]Apple[/TD]
[TD]Banana[/TD]
[TD]Orange[/TD]
[TD]Pear[/TD]
[/TR]
[TR]
[TD]Apple
[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Banana[/TD]
[TD]0[/TD]
[TD]10[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Pear[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]6[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]

So in the above, 12 customer's bought an Orange and an Apple, 10 customers bought 2 banana's, 6 customer's bought a Pear and an Orange and 5 customer's bought a Pear and an Apple.

Ideally I'd like to rank the most frequently bought combinations and the number of times this combination was purchased. So the data will be outputted in the below format:

[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Product 1[/TD]
[TD]Product 2[/TD]
[TD]Quantity[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Apple[/TD]
[TD]Orange[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Banana[/TD]
[TD]Banana[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Orange[/TD]
[TD]Pear[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Apple[/TD]
[TD]Pear[/TD]
[TD]5
[/TD]
[/TR]
</tbody>[/TABLE]

Due to how the data is laid out there is double-counting of combinations, but I am hoping that these duplicates can be easily identified and removed once the data is in the required format.

Many thanks.

 

[MickG]

Try this for Results starting "G1".

[COLOR="Navy"]Sub[/COLOR] MG16Apr55
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = ActiveSheet.Cells(1).CurrentRegion
    ReDim nray(1 To UBound(Ray, 1) + 1, 1 To 3)
        nray(1, 1) = "Product 1": nray(1, 2) = "Product 2": nray(1, 3) = "Quantity"
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray)
  c = c + 1
 [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Ray(n, ac) <> 0 [COLOR="Navy"]Then[/COLOR]
           nray(c, 1) = Ray(n, 1)
            nray(c, 2) = Ray(1, ac)
            nray(c, 3) = Ray(n, ac)
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] n
Range("G1").Resize(c, 3).Value = nray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[MickG]

Hi Tim , please keep general correspondence relating to this thread with the original.
Your Pm:-

Hello Mick,

Thanks for your response to my question.

I've never used VBA before but I managed to get it into the test file and it worked perfectly!

However, I have no idea how to adapt this to the actual file that I need to apply it to. Am I able to send you the file or can you use the cell references below?

Data starts in A1 and ends in QH450.

Many thanks,
Tim

That code should work for your extended Data, Perhaps with slight addition as below.
NB:- Results now start "Sheet2", "A1"

[COLOR=navy]Sub[/COLOR] MG17Apr04
im Ray [COLOR=navy]As[/COLOR] Variant, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
 Ray = ActiveSheet.Cells(1).CurrentRegion
    ReDim nray(1 To UBound(Ray, 1) + 1, 1 To 3)
        nray(1, 1) = "Product 1": nray(1, 2) = "Product 2": nray(1, 3) = "Quantity"
c = 1
[COLOR=navy]For[/COLOR] n = 2 To UBound(Ray)
  c = c + 1
 [COLOR=navy]For[/COLOR] ac = 2 To UBound(Ray, 2)
        [COLOR=navy]If[/COLOR] Ray(n, ac) <> 0 [COLOR=navy]Then[/COLOR]
           nray(c, 1) = Ray(n, 1)
           nray(c, 2) = Ray(1, ac)
           nray(c, 3) = Ray(n, ac)
        [COLOR=navy]End[/COLOR] If
  [COLOR=navy]Next[/COLOR] ac
[COLOR=navy]Next[/COLOR] n
 [COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR=navy]End[/COLOR] With
 [COLOR=navy]On[/COLOR] [COLOR=navy]Error[/COLOR] [COLOR=navy]Resume[/COLOR] [COLOR=navy]Next[/COLOR]
 Sheets("Sheet2").Range("a1").Resize(c).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[tbollo]

Hello Mick,

Apologies I am a noob.

Thanks for the reply and it is very close to what I need!

However, there's actually multiple quantities of combinations on each row (sorry, I should have been clearer on this part). I have adapted the original data supplied below to highlight this:


[TABLE="class: cms_table, width: 500"]
<tbody>[TR]
[TD]Product(s)[/TD]
[TD]Apple[/TD]
[TD]Banana[/TD]
[TD]Orange[/TD]
[TD]Pear[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]5[/TD]
[/TR]
[TR]
[TD]Banana[/TD]
[TD]0[/TD]
[TD]10[/TD]
[TD]15[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]12[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]Pear[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]6[/TD]
[TD]7[/TD]
[/TR]
</tbody>[/TABLE]


It looks like the answer you supplied was picking up the last combination in each row. Is there anyway to get the results I need if the data is laid out as above?

Many thanks,

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG17Apr12
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
 Ray = ActiveSheet.Cells(1).CurrentRegion
    ReDim nray(1 To UBound(Ray, 1) * UBound(Ray, 2), 1 To 3)
        nray(1, 1) = "Product 1": nray(1, 2) = "Product 2": nray(1, 3) = "Quantity"
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray)
  [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Ray(n, ac) <> 0 [COLOR="Navy"]Then[/COLOR]
           c = c + 1
           nray(c, 1) = Ray(n, 1)
           nray(c, 2) = Ray(1, ac)
           nray(c, 3) = Ray(n, ac)
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] n
 [COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("a1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
 [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[tbollo]

Perfect!

Thank you, Mick.

 

[MickG]

You're welcome