Combination Help

[eyal8r]

Hey guys-
I have a list of 10 of my favorite/lucky numbers that I want to play in the lottery. The lottery picks 5 numbers total. I need a way to show me all the possible combinations of my 10 numbers picked in a 5 number draw (hope that makes sense). There are no repeat combinations- for example- I DO NOT WANT 1-2-3-4-5 and 5-4-3-2-1 to come up as separate combinations- so each of my favorite #s needs to be used only once in each combination, and each set used once.

I have searched this board for 2 hours now- read tons of other posts, but not finding a real solution. The output will be a list of all the possible combinations (no repeats, and no permutations) using my 10 favorite numbers. Another example-
1-2-3-4-5
1-2-3-4-6
1-2-3-4-7
1-2-3-4-8
1-2-3-4-9
1-2-3-5-6
1-2-3-5-7
and so on.

How do I create this? I realize the resulting table will be quite a large number of combinations- but we're going to have fun with it and pick a few at random. Any help is appreciation!

 

[pgc01]

Hi Stephen

The variables never decrease, they only increase. You are seeing the values of variables with the same name but they are not the same variable. Each time CombinationsNP calls itself, it will define its own iIndex. When the function ends it resturns back to the statement after where it was called (in this case the End If) in the same Sub. That's why you see as if iIndex is decreasing when in fact, when you return, iIndex in the previous loop will increase.

Maybe a small example will clarify it:

Sub Test()
  Call Sub1(True)
End Sub

Sub Sub1(bContinue)
Dim i

For i = 1 To 2
    MsgBox i
    If bContinue Then Call Sub1(False)
    MsgBox i
Next i
End Sub

Since Sub1 calls itself with the parameter False, it will not continue the recursion and so we just have 2 levels.

Excute Test and check the values if i in the 2 levels.


Test() starts executing. It calls Sub1().

Sub 1 in first level

i=1 (before the If)

Sub1 calls itself, goes to second level

i=1 (before the If)
i=1 (after the If)
i=2 (before the If)
i=2 (after the If)

Ends loop, returns to level 1 just after the If

i=1 (after the If)
i=2 (before the If)

Sub1 calls itself, goes to second level

i=1 (before the If)
i=1 (after the If)
i=2 (before the If)
i=2 (after the If)

Ends loop, returns to level 1

i=2 (after the If)

Ends loop, returns to Test()

Hope this clarifies the question.

 

[Stephen_Tsui]

Hi pgc01:

Thanks, I know how the call programme run, It run like Seed.
It must be very useful for my later programme, thx.

 

[pgc01]

I'm glad I was able to help.

Cheers

 

[pgc01]

Hi CARBOB

I have but one question, is it possible to have the macro do either Permutations or Combinations?

I adjusted the code to generate the 4 kinds of combinations/permutations.
It runs in memory now, so it's much (much) faster. You'll notice it well if you have a total number of combinations/permutations very big.

I had to add
- an array to hold all the results
- 2 booleans, bComb and bRepet, to define the operation:

bComb=True, bRepet=False - Combinations without repetition
bComb=True, bRepet=True - Combinations with repetition
bComb=False, bRepet=False - Permutations without repetition
bComb=False, bRepet=True - Permutations without repetition

You can adjust all the locations of the inputs/outputs. If you use the layout I post you just have to run the code.

Option Explicit

' 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 CombPerm()
Dim rRng As Range, p As Integer
Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
Dim lRow As Long, bComb As Boolean, bRepet As Boolean

' Get the inputs and clear the result range (you may adjust for other locations)
Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked
bComb = Range("B2")
bRepet = Range("B3")
Columns("D").Resize(, p + 1).Clear

' Error
If (Not bRepet) And (rRng.Count< p) Then
    MsgBox "With no repetition the number of elements of the set must be bigger or equal to p"
    Exit Sub
End If

' Set up the arrays for the set elements and the result
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
With Application.WorksheetFunction
    If bComb = True Then
            lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
    Else
        If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
    End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)

' Calculate the Combinations / Permutations
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)
Range("D1").Resize(lTotal, p).Value = vResultAll  'you may adjust for other location
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

The example is:
4 people are ranked according to their skills in excel. What are the possible rankings (left to right is rank 1 to 4).

in B1: p
in B2: True for combinations, False for permutations
in B3: True for repetition allowed, False for repetition not allowed
in B5, down: the set of elements

CombPerm.xls
	A	B	C	D	E	F	G	H
1	p	4		John	Mary	Kay	Fred
2	Comb	FALSE		John	Mary	Fred	Kay
3	Repet	FALSE		John	Kay	Mary	Fred
4				John	Kay	Fred	Mary
5	Set	John		John	Fred	Mary	Kay
6		Mary		John	Fred	Kay	Mary
7		Kay		Mary	John	Kay	Fred
8		Fred		Mary	John	Fred	Kay
9				Mary	Kay	John	Fred
10				Mary	Kay	Fred	John
11				Mary	Fred	John	Kay
12				Mary	Fred	Kay	John
13				Kay	John	Mary	Fred
14				Kay	John	Fred	Mary
15				Kay	Mary	John	Fred
16				Kay	Mary	Fred	John
17				Kay	Fred	John	Mary
18				Kay	Fred	Mary	John
19				Fred	John	Mary	Kay
20				Fred	John	Kay	Mary
21				Fred	Mary	John	Kay
22				Fred	Mary	Kay	John
23				Fred	Kay	John	Mary
24				Fred	Kay	Mary	John
25
Sheet1

 

[CARBOB]

PGC01,
Do I input both sets of code in the same module?

 

[pgc01]

CARBOB

It's one program with 2 Subs. Paste all in the same module. To execute the program run the first Sub.

The first Sub gathers the inputs from the worksheet, calls the second Sub and writes the output to the worksheet.
The second Sub generates the permutations/combinations.

The first sub just does the Input/output. It's the second sub that has the brains.

 

[CARBOB]

This is the way I entered the data and I got an Expected End Statement @bComb=True,

Book1
	B	C	D	E
1	6
2	FALSE
3	FALSE
4
5	3
6	2
7	1
8	0
9
Sheet1

Option Explicit

bComb=True, bRepet=False - Combinations without repetition
bComb=True, bRepet=True - Combinations with repetition
bComb=False, bRepet=False - Permutations without repetition
bComb=False, bRepet=True - Permutations without repetition

' 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 CombPerm()
Dim rRng As Range, p As Integer
Dim vElements As Variant, vResult As Variant, vResultAll As Variant, lTotal As Long
Dim lRow As Long, bComb As Boolean, bRepet As Boolean

' Get the inputs and clear the result range (you may adjust for other locations)
Set rRng = Range("B5", Range("B5").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked
bComb = Range("B2")
bRepet = Range("B3")
Columns("D").Resize(, p + 1).Clear

' Error
If (Not bRepet) And (rRng.Count< p) Then
    MsgBox "With no repetition thtruee number of elements of the set must be bigger or equal to p"
    Exit Sub
End If

' Set up the arrays for the set elements and the result
vElements = Application.Index(Application.Transpose(rRng), 1, 0)
With Application.WorksheetFunction
    If bComb = True Then
            lTotal = .Combin(rRng.Count + IIf(bRepet, p - 1, 0), p)
    Else
        If bRepet = False Then lTotal = .Permut(rRng.Count, p) Else lTotal = rRng.Count ^ p
    End If
End With
ReDim vResult(1 To p)
ReDim vResultAll(1 To lTotal, 1 To p)

' Calculate the Combinations / Permutations
Call CombPermNP(vElements, p, bComb, bRepet, vResult, lRow, vResultAll, 1, 1)
Range("D1").Resize(lTotal, p).Value = vResultAll  'you may adjust for other location
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

 

[pgc01]

bComb=True, bRepet=False - Combinations without repetition 
bComb=True, bRepet=True - Combinations with repetition 
bComb=False, bRepet=False - Permutations without repetition 
bComb=False, bRepet=True - Permutations without repetition

These 4 lines are not part of the code. I just wrote it in my post to explain how to choose the 4 different possibilities.

So either delete them or comment them.

Remark:

Your example will not work.

It's not possible to make groups of 6 elements when the set has only a total of 4 elements, unless you allow repetition.

so,

- either specify p as less or equal to 4
- or set B3 = True, allowing repetition

 

[CARBOB]

pgc01, you are a genius. I have always wanted a program like this. Thank you! Thank you! Works like a champ.

 

[pgc01]

I'm glad you got it working.

Since I just wrote it, it's not fully tested. If you find any case that doesn't work please post it.

Cheers