Complicated Counting Combinations in a Row

[JScotty317]

Hey Folks,

Thanks up front for your help. I've spent way too much time with trial and errors so it's time to tap you all for your expertise. Using the table below, I'm trying to calculate how many unique values there are as well as how many unique combinations. The real dataset is hundreds of thousands of rows and has hundreds of unique values. Let's use this to highlight what I'm trying to do.

Fruit1	Fruit2	Fruit3	Fruit4	Fruit5
Banana	Apple	Grape
Strawberry
Strawberry	Grape	Berry	Banana	Apple
Apple	Grape
Berry	Strawberry	Banana	Grape

How many times does each fruit appear in the table?

• Grape - 4
• Apple - 3
• Banana - 3
• Strawberry - 3
• Berry - 2

How many times does a fruit get eaten in conjunction with each other fruit? Let's say, how many times someone ate a Strawberry with something else (what else is on the same row as Strawberry).

• Banana - 2
• Grape - 2
• Apple - 1
• Berry - 1

What formula can I use for this last part? I have tried a bunch of variations and nothing seems to work correctly. Thank you in advance! - Justin

 

[Eric W]

Counting how many times a single fruit appears is easy. How many times 2 fruits appear together is tougher. Consider:

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	Fruit1	Fruit2	Fruit3	Fruit4	Fruit5		Fruit	Count			Apple	Banana	Berry	Grape	Strawberry	Watermelon
2	Banana	Apple	Grape				Apple	3		Apple	*	2	1	3	1	0
3	Strawberry						Banana	4		Banana	2	*	2	3	2	1
4	Strawberry	Grape	Berry	Banana	Apple		Berry	2		Berry	1	2	*	2	2	0
5	Apple	Grape					Grape	4		Grape	3	3	2	*	2	0
6	Berry	Strawberry	Banana	Grape			Strawberry	3		Strawberry	1	2	2	2	*	0
7		Watermelon		Banana			Watermelon	1		Watermelon	0	1	0	0	0	*
Sheet4

Cell Formulas
Range	Formula
K2:P7	K2	=IF($J2=K$1,"*",SUMPRODUCT(--(MMULT(($A$2:$E$7=$J2)+($A$2:$E$7=K$1),TRANSPOSE(COLUMN($A$2:$E$2)^0))>1)))
H2:H7	H2	=COUNTIF($A$2:$E$7,G2)
Press CTRL+SHIFT+ENTER to enter array formulas.

The H2 formula is a simple COUNTIF. The K2 formula is trickier. It also assumes that you won't have the same fruit more than once in a row.

The formula is pretty calculation intensive, and will definitely slow down your sheet if you have 100's of thousands of rows, and could crash it. This is more suitable to VBA. I recently did a macro to do that, I'll see if I can find the link.

 

[Sulprobil]

If I am not mistaken, I am getting the same output as Eric with his sample data:

MrExcel_Complicated Counting Combinations in a Row.xlsm
	A	B	C	D	E	F	G
1		Banana	Apple	Grape	Strawberry	Berry	Watermelon
2	Banana	4	2	3	2	2	1
3	Apple	2	3	3	1	1
4	Grape	3	3	4	2	2
5	Strawberry	2	1	2	3	2
6	Berry	2	1	2	2	2
7	Watermelon	1					1
Output

Input was:

MrExcel_Complicated Counting Combinations in a Row.xlsm
	A	B	C	D	E
1	Fruit 1	Fruit 2	Fruit 3	Fruit 4	Fruit 5
2	Banana	Apple	Grape
3	Strawberry
4	Strawberry	Grape	Berry	Banana	Apple
5	Apple	Grape
6	Berry	Strawberry	Banana	Grape
7	Watermelon	Banana
Input

Option Explicit

Sub FruitStats()
Dim i As Long, j As Long, k As Long, fCol As Long, lF As Long
Dim objFruit As Object
Dim vI As Variant, vO As Variant
Dim state As SystemState    'See https://berndplumhoff.gitbook.io/sulprobil/excel/excel-vba-solutions/classes/systemstate

On Error GoTo ErrHdl
Set state = New SystemState 'Speed up VBA
Set objFruit = CreateObject("Scripting.Dictionary")
ReDim sFruit(1 To 1000) As String

'First pass - how many and which fruits do we have
Do While Not IsEmpty(wsI.Cells(1, fCol + 1))
    fCol = fCol + 1 'No of fruit columns
Loop
vI = Range(wsI.Cells(2, 1), wsI.Cells(wsI.Cells(1, 1).End(xlDown).Row, fCol))
For i = LBound(vI, 1) To UBound(vI, 1)
    j = LBound(vI, 2)
    Do While j <= UBound(vI, 2)
        If vI(i, j) = "" Then Exit Do
        If Not objFruit.exists(vI(i, j)) Then
            lF = lF + 1
            sFruit(lF) = vI(i, j)
            objFruit(vI(i, j)) = lF 'Link into sFruit
        End If
        j = j + 1
    Loop
Next i
ReDim Preserve sFruit(1 To lF)
ReDim vFruit(1 To lF, 1 To lF) As Variant

'Second Pass - fill two-dimensional array vFruit
For i = LBound(vI, 1) To UBound(vI, 1)
    For j = LBound(vI, 2) To UBound(vI, 2)
        For k = LBound(vI, 2) To UBound(vI, 2)
            If vI(i, j) <> "" And vI(i, k) <> "" Then
                vFruit(objFruit(vI(i, j)), objFruit(vI(i, k))) = vFruit(objFruit(vI(i, j)), objFruit(vI(i, k))) + 1
            End If
        Next k
    Next j
Next i

'Third pass - fill output sheet
Range(wsO.Cells(1, 1), wsO.Cells(1 + lF, 1)).EntireRow.Delete
Range(wsO.Cells(1, 2), wsO.Cells(1, 1 + lF)).FormulaArray = objFruit.keys()
Range(wsO.Cells(2, 1), wsO.Cells(1 + lF, 1)).FormulaArray = Application.WorksheetFunction.Transpose(objFruit.keys())
Range(wsO.Cells(2, 2), wsO.Cells(1 + UBound(vFruit, 1), 1 + UBound(vFruit, 2))).FormulaArray = vFruit

Set state = Nothing 'Not even necessary - will be done automatically
Exit Sub
ErrHdl:
If Err.Number = 9 Then
   If lF > UBound(sFruit, 1) Then
       'Here we get if we breach Ubound(sFruit,1)
       'So we need to get a bigger "basket"
       ReDim Preserve sFruit(1 To UBound(sFruit, 1) * 2)
       Resume 'Back to statement which caused error
   End If
End If
'Other error - terminate
On Error GoTo 0
Resume
End Sub

The file can be downloaded here (download, open, and use at your own risk, but I am using an up-to-date virus scanning program):

Dropbox - File Deleted - Simplify your life

www.dropbox.com

 

[Fluff]

@Sulprobil
Can you please post all the code needed to run you macro, rather than just some of it.

 

[Sulprobil]

@Fluff
Can you please download the file provided, because the code fragment was just shown to present the central coding approach.
If you think this does not comply with your posting guidelines, let me know how to present this somewhat advanced program.
Thank you.

 

[Fluff]

Some members cannot, or will not, download files for security reasons, therefore we ask that all code should be posted to the board (you can also supply a workbook to download as well).
All you need to do is post the class code as well, the best way is to do something like

Place this in a standard module

'Your code goes here

Also create a new class module, call it xyz & paste this into it

'your class code

 

[JScotty317]

Thank you so much! I can't tell you how much manual effort you've saved or some interns! Gotta love the excellent assistance you get here at MrExcel!