unique combinations generator

[mikiel111]

Hi there,

I`ve got this issue which i just cannot seem to get to the bottom of.
I need a unique combination generator from entries in 1 column. To elaborate, I have 1 column with any number of rows (A, B, C, D etc...) in sheet A & I need to output unique combinations of all the entries from that column in groups of 5 in Sheet B
So let`s say I have Column 1 with A, B, C, D & E in the rows. I need to output the unique combinations of those (e.g. AAAAA AAAAB AAAAC, AAAAD, AAABC, AAABD etc...). The order of the letters is not important, so tby that I mean if I have AAAAB I dont want AAABA, AABAA, ABAAA & BAAAA.
I found an excel file on the internet which does what seems like I need it to do but the knowledge behind it is waaaaayy beyond me (hence why i`m reaching out for help) so I cannot copy it, see whats happening or recreate it in my own file.

Is there some way I can attach it so you see what I am talking about?

 

[StephenCrump]

Try this:

Workbook: Combinations2.xlsm

Combinations2.xlsm
	A	B	C	D	E
1
2			1		1
3			1		2
4			1		3
5			1		4
6			1		5
7			2		2
8			2		3
9			2		4
10			2		5
11			3		3
12			3		4
13			3		5
14			4		4
15			4		5
16			5		5
DailyMealMacro

Combinations2.xlsm
	A	B
1
2
3
4
5
6
7
8
9
10	1	Description 1
11	2	Description 2
12	3	Description 3
13	4	Description 4
14	5	Description 5
MealList

Worksheet scoped named ranges:
StartRow: =DailyMealMacro!$C$2
StartRow: =MealList!$A$10

I've left the combination arrays as Variant. You're right - declaring as Long would make the code faster, but it's not really an issue until the numbers start getting large.

Incidentally, I also changed my Sub name from Go to DoIt. I have never had problems with Go before, but it's a reserved word, and the compiler suddenly started throwing Expected: To errors.

' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' vElements - Array with the set elements (1 to n)
' p - number of elements in 1 combination/permutation
' bComb - True: Combinations, False: Permutations
' bRepet - True: with repetition, False: without repetition
' vResult - Array to hold 1 permutation/combination (1 to p)
' lRow - row number. the next combination/permutation is written in lRow+1
' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
' iElement - order of the element to process in case of combination
' iIndex - position of the next element in the combination/permutation
' Sub CombPerm() deals with the input / output
' Sub CombPermNP() generates the combinations / permutations
Sub DoIt()

    Dim vElements As Variant, vResult As Variant, vResultAll As Variant
    Dim lrow As Long, lTotal As Long, p As Long, pMax As Long, i As Long, NoRows As Long
    Dim bComb As Boolean, bRepet As Boolean
    Dim rng As Range
    
    p = 2       'Number of elements in combination
    pMax = 6    'Careful! The code clears this many columns, i.e. C,E,G,I,K,M for pMax=6
    bComb = True
    bRepet = True
    With Worksheets("MealList")
        Set rng = .Range("A" & .Range("StartRow").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    vElements = Application.Index(Application.Transpose(rng), 1, 0)
    
    With Application
        If bComb Then
            lTotal = .Combin(UBound(vElements) + IIf(bRepet, p - 1, 0), p)
        Else
            If bRepet = False Then lTotal = .Permut(UBound(vElements), p) Else lTotal = UBound(vElements) ^ p
        End If
    End With
    ReDim vResult(1 To p)
    ReDim vResultAll(1 To lTotal, 1 To p)

    Call CombPermNP(vElements, p, True, True, vResult, lrow, vResultAll, 1, 1)
    
    With Worksheets("DailyMealMacro").Range("StartRow")
        NoRows = .End(xlDown).Row - .Row + 1
        For i = 0 To p - 1
            With .Offset(, 2 * i)
                .Resize(NoRows).ClearContents
                .Resize(lTotal).Value = Application.Index(vResultAll, , i + 1)
            End With
        Next i
        For i = p To pMax - 1
            .Offset(, 2 * i).Resize(NoRows).ClearContents
        Next i
    End With
    
End Sub
Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
                             ByVal vResult As Variant, ByRef lrow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
Dim i As Integer, j As Integer, bSkip As Boolean
 
For i = IIf(bComb, iElement, 1) To UBound(vElements)
    bSkip = False
    ' in case of permutation without repetition makes sure the element is not yet used
    If (Not bComb) And Not bRepet Then
        For j = 1 To p
            If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
                bSkip = True
                Exit For
            End If
        Next
    End If
 
    If Not bSkip Then
        vResult(iIndex) = vElements(i)
        If iIndex = p Then
            lrow = lrow + 1
            For j = 1 To p
                vResultAll(lrow, j) = vResult(j)
            Next j
        Else
            Call CombPermNP(vElements, p, bComb, bRepet, vResult, lrow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
        End If
    End If
Next i
End Sub

 

[mikiel111]

Yours works without a problem. I simply change p based on what i need, I also replaced StartRow with the corresponding thing you wrote.
BUT
My worksheets have spaces in them Meal List not MealList & Daily Meal Macro not DailyMealMacro (and i already have lots of formules built on the sheets with spaces)
So i thought i`d do something smart (turns out it isnt as i`m getting an error)

I renamed

With Worksheets("MealList")

to

With Worksheets("Meal List")

With Worksheets("DailyMealMacro")

to

With Worksheets("Daily Meal Macro")

I also replaced the following
Note the space between the sheet names in the code

[/I]Set rng = .Range("A" & .Range("=MealList!$A$10").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)

to

Set rng = .Range("A" & .Range("=Meal List!$A$10").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)

and

With Worksheets("Daily Meal Macro").Range("=DailyMealMacro!$C$2")

to

With Worksheets("Daily Meal Macro").Range("=Daily Meal Macro!$C$2")

I also tried some different variations/trial and error by putting spaces in the sheet names but keeping it without spaces in the code etc... and got errors

The errors I get are 'subscript out of range (runtime error 9)' (debug highlights this line With Worksheets("Meal List")) and another one i got was related to objects (debug highlights Set rng = .Range("A" & .Range("=Meal List!$A$10").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row))

 

[StephenCrump]

My worksheets have spaces in them Meal List not MealList & Daily Meal Macro not DailyMealMacro

I also replaced StartRow with the corresponding thing you wrote.

Oops, sorry about the worksheet names. In my code, you simply need to replace two references:

'from
With Worksheets("MealList")
'to
With Worksheets("Meal List")
        
.. and from
With Worksheets("DailyMealMacro").Range("StartRow")
'to
With Worksheets("Daily Meal Macro").Range("StartRow")

FYI, these references could use the worksheet's codename instead of the name. Then even if the user changed the sheet name, the code would still work. You might want to have a look at this option sometime.

The two StartRow references are worksheet-scoped names defined in my workbook. XL2BB didn't list these formulae, so I gave the formulae so that anyone not downloading the workbook could still create the layout. Have a look in my workbook how they are set up.

 

[mikiel111]

I did as you said and it mine i keep getting Runtime Error 1004, Application Defined or object defined error . Debugger highlights this line:

Set rng = .Range("A" & .Range("StartRow").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)

In your workbook it works even when I renamed them to match mine exactly. In mine I ensured i have the 6 columns C,E,G,I,K,M empty. I dragged the code from yours to mine and i visually compared it so it`s not like i changed it.

 

[StephenCrump]

It's a little difficult to debug based on only one line of code.

Can you please post ALL the relevant code you are using in your workbook?

 

[mikiel111]

 ' PGC Set 2007
' Calculates and writes the Combinations / Permutations with/without repetition
' vElements - Array with the set elements (1 to n)
' p - number of elements in 1 combination/permutation
' bComb - True: Combinations, False: Permutations
' bRepet - True: with repetition, False: without repetition
' vResult - Array to hold 1 permutation/combination (1 to p)
' lRow - row number. the next combination/permutation is written in lRow+1
' vResultAll - Array to hold all the permutations/combinations (1 to Total, 1 to p)
' iElement - order of the element to process in case of combination
' iIndex - position of the next element in the combination/permutation
' Sub CombPerm() deals with the input / output
' Sub CombPermNP() generates the combinations / permutations
Sub DoIt()

    Dim vElements As Variant, vResult As Variant, vResultAll As Variant
    Dim lrow As Long, lTotal As Long, p As Long, pMax As Long, i As Long, NoRows As Long
    Dim bComb As Boolean, bRepet As Boolean
    Dim rng As Range
    
    p = 2       'Number of elements in combination
    pMax = 6    'Careful! The code clears this many columns, i.e. C,E,G,I,K,M for pMax=6
    bComb = True
    bRepet = True
    With Worksheets("Meal List")
        Set rng = .Range("A" & .Range("StartRow").Row & ":A" & .Range("A" & Rows.Count).End(xlUp).Row)
    End With
    vElements = Application.Index(Application.Transpose(rng), 1, 0)
    
    With Application
        If bComb Then
            lTotal = .Combin(UBound(vElements) + IIf(bRepet, p - 1, 0), p)
        Else
            If bRepet = False Then lTotal = .Permut(UBound(vElements), p) Else lTotal = UBound(vElements) ^ p
        End If
    End With
    ReDim vResult(1 To p)
    ReDim vResultAll(1 To lTotal, 1 To p)

    Call CombPermNP(vElements, p, True, True, vResult, lrow, vResultAll, 1, 1)
    
    With Worksheets("Daily Meal Macro").Range("StartRow")
        NoRows = .End(xlDown).Row - .Row + 1
        For i = 0 To p - 1
            With .Offset(, 2 * i)
                .Resize(NoRows).ClearContents
                .Resize(lTotal).Value = Application.Index(vResultAll, , i + 1)
            End With
        Next i
        For i = p To pMax - 1
            .Offset(, 2 * i).Resize(NoRows).ClearContents
        Next i
    End With
    
End Sub
Sub CombPermNP(ByVal vElements As Variant, ByVal p As Integer, ByVal bComb As Boolean, ByVal bRepet As Boolean, _
                             ByVal vResult As Variant, ByRef lrow As Long, ByRef vResultAll As Variant, ByVal iElement As Integer, ByVal iIndex As Integer)
Dim i As Integer, j As Integer, bSkip As Boolean
 
For i = IIf(bComb, iElement, 1) To UBound(vElements)
    bSkip = False
    ' in case of permutation without repetition makes sure the element is not yet used
    If (Not bComb) And Not bRepet Then
        For j = 1 To p
            If vElements(i) = vResult(j) And Not IsEmpty(vResult(j)) Then
                bSkip = True
                Exit For
            End If
        Next
    End If
 
    If Not bSkip Then
        vResult(iIndex) = vElements(i)
        If iIndex = p Then
            lrow = lrow + 1
            For j = 1 To p
                vResultAll(lrow, j) = vResult(j)
            Next j
        Else
            Call CombPermNP(vElements, p, bComb, bRepet, vResult, lrow, vResultAll, i + IIf(bComb And bRepet, 0, 1), iIndex + 1)
        End If
    End If
Next i
End Sub

 

[StephenCrump]

It looks like you haven't defined StartRow in the workbook (in Excel, not in VBA).

Look in my workbook, and you'll see in Names Manager that I have defined two worksheet scoped names: StartRow, pointing to:
='Meal List''!$A$10 (the start of my element list), and
='Daily Meal Macro'!$C$2 (the first output cell for the combinations).

You'll need to do similar in your workbook.

(The alternative would be to hard-code the cell references in VBA, but this wouldn't be dynamic - if the user started inserting/deleting rows/columns, the code would look for the elements in the wrong place, and/or put the combination results in the wrong place)

 

[mikiel111]

ohh i completely missed that. I got it working perfectly now. Thank you so much for your time and patience!

 

[StephenCrump]

I`m doing my best to stay away from code as I know nothing about coding ....

.....

I got it working perfectly now.

Well done! That's good to hear.

 

[mikiel111]

.....

I assumed it would be much more complicated and would create a nightmare for me. But i guess when you have people to help you it changes everything