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!

 

[Stephen_Tsui]

Test

Try

Is anybody know how to post image, here, thx?

Sub Drawing()

Dim myAr() As Variant
Dim myRang As Range
Dim p As Integer
Dim ResultRow As Integer

p = Range("B1")

Set myRang = Range("A1").Resize(p)
ReDim myAr(p, 1 To 2)

For i = 1 To p
    myAr(i, 1) = myRang.Cells(i)
    Randomize
    myAr(i, 2) = Rnd()
Next i

BubbleSort myAr

ResultRow = Range("c65536").End(xlUp).Offset(1).Row

For i = 1 To p
    Cells(ResultRow, i + 2) = myAr(i, 1)
Next i

End Sub

Sub BubbleSort(myAr() As Variant)

For i = 1 To UBound(myAr) - 1
    For j = i + 1 To UBound(myAr)
        If myAr(i, 2) > myAr(j, 2) Then
            For k = 1 To 2
                mytemp = myAr(i, k)
                myAr(i, k) = myAr(j, k)
                myAr(j, k) = mytemp
            Next k
        End If
    Next j
Next i
    
End Sub

[/img][/url]

 

[pgc01]

Hi Stephen

You can use Colo's tool to post a table like the one I posted:

http://www.mrexcel.com/board2/viewtopic.php?t=92622

CARBOB

In this case you can also use a formula. With the table I posted, in C1:

=IF(OR(COLUMNS($C1:C1)>$B$1,ROWS(C$1:C1)>ROWS($A$1:$A$3)^$B$1),"",INDEX($A$1:$A$3,1+MOD(INT((ROWS(C$1:C1)-1)/ROWS($A$1:$A$3)^(COLUMNS($C1:C1)-1)),ROWS($A$1:$A$3))))

Copy down and accross

 

[CARBOB]

Hi Stephen

You can use Colo's tool to post a table like the one I posted:

http://www.mrexcel.com/board2/viewtopic.php?t=92622

CARBOB

In this case you can also use a formula. With the table I posted, in C1:

=IF(OR(COLUMNS($C1:C1)>$B$1,ROWS(C$1:C1)>ROWS($A$1:$A$3)^$B$1),"",INDEX($A$1:$A$3,1+MOD(INT((ROWS(C$1:C1)-1)/ROWS($A$1:$A$3)^(COLUMNS($C1:C1)-1)),ROWS($A$1:$A$3))))

Copy down and accross

Thanks to both of you for responding. pgc01, the macro works, but is very, very slow. Created 400 combinations in 3 hours. I will test the other macro today. Do I have the setup correct for your formula?

CASH 3 1ST DIGIT.xls
	A	B	C	D	E	F	G	H
1	3	6	3	3	3	3	3	3
2	2		2	3	3	3	3	3
3	1		1	3	3	3	3	3
4	0		0	3	3	3	3	3
5			3	2	3	3	3	3
6			2	2	3	3	3	3
7			1	2	3	3	3	3
Sheet1

 

[pgc01]

Hi CARBOB

pgc01, the macro works, but is very, very slow. Created 400 combinations in 3 hours. I will test the other macro today. Do I have the setup correct for your formula?

Don't use the formula for a big number of permutations, if you have the worksheet with a lot of array formulas it should get slow.

Now, for the macro, that's another story. I cannot understand how it could take 3 hours to create 400 permutations.

In fact I just timed the case you posted (4 numbers, 6 positions) and in the several times I ran the code it took between 0.38s and 0.44 s to generate the 4096 permutations.

I also tried just for curiosity's sake, 4 numbers with 8 positions. This gives 65536 permutations and it took between 5.5s and 6 s.

It's true that you could have better results if you would work in memory but the code is so fast that it's not worth it.

Please try the following: Close excel, open a new workbook, copy the code from this thread into a general module and run it.

Please post back the result.

 

[CARBOB]

Re: Test

Try

Is anybody know how to post image, here, thx?

Sub Drawing()

Dim myAr() As Variant
Dim myRang As Range
Dim p As Integer
Dim ResultRow As Integer

p = Range("B1")

Set myRang = Range("A1").Resize(p)
ReDim myAr(p, 1 To 2)

For i = 1 To p
    myAr(i, 1) = myRang.Cells(i)
    Randomize
    myAr(i, 2) = Rnd()
Next i

BubbleSort myAr

ResultRow = Range("c65536").End(xlUp).Offset(1).Row

For i = 1 To p
    Cells(ResultRow, i + 2) = myAr(i, 1)
Next i

End Sub

Sub BubbleSort(myAr() As Variant)

For i = 1 To UBound(myAr) - 1
    For j = i + 1 To UBound(myAr)
        If myAr(i, 2) > myAr(j, 2) Then
            For k = 1 To 2
                mytemp = myAr(i, k)
                myAr(i, k) = myAr(j, k)
                myAr(j, k) = mytemp
            Next k
        End If
    Next j
Next i
    
End Sub

[/img][/url]

Stephen, I get a variable not defined, I know nothing about macros.

 

[Stephen_Tsui]

Teach me the programme wrote on this board, thx.

Hi pgc01

I' ve tried to understand the programme you write before, but some idea can't grasp.

This is the order of Outcome of this programme tested:

Supposed P = 3, velements = ( A,B,C,D,E,F )

1. iindex = 1 , Outcome=A, i = 1
2. iindex = 2 , Outcome=B, i = 2
3. iindex = 3 , Outcome=C, i = 3
4. iindex = 3 , Outcome=D, i = 4
5. iindex = 3 , Outcome=E, i = 5
6. iindex = 3 , Outcome=F, i = 6

7. iindex = 2 , Outcome=C, i = 3

8. iindex = 3 , Outcome=D, i = 4

I don't know why in step 7, iindex deduct 1, and also don't know why the looping still not stop when the step 6 finished, plz teach me, thx.

For i = iElement To UBound(vElements)
    vresult(iIndex) = vElements(i)
    If iIndex = p Then
        lRow = lRow + 1
        Range("C" & lRow).Resize(, p) = vresult
    Else
        Call CombinationsNP(vElements, p, vresult, lRow, i + 1, iIndex + 1)
    End If
Next i

 

[Stephen_Tsui]

Hi CARBOB:

The Operation of this programme is liked programme of pgc01 pasted before,
Enter No of People in cells B1, Column A as People List,

It is a programme drawing no duplicate combination.

Here is a new programme rewrote:

Sub Drawing()

Dim myAr() As Variant
Dim myRang As Range
Dim p As Integer
Dim ResultRow As Integer

q = Range("B1")

Set myRang = Range(Range("A1"), Range("A65536").End(xlUp))
ReDim myAr(myRang.Rows.Count, 1 To 2)

For i = 1 To myRang.Rows.Count
    myAr(i, 1) = myRang.Cells(i)
    Randomize
    myAr(i, 2) = Rnd()
Next i

BubbleSort myAr

ResultRow = Range("c65536").End(xlUp).Offset(1).Row

For i = 1 To q
    Cells(ResultRow, i + 2) = myAr(i, 1)
Next i

End Sub

Sub BubbleSort(myAr() As Variant)

For i = 1 To UBound(myAr) - 1
    For j = i + 1 To UBound(myAr)
        If myAr(i, 2) > myAr(j, 2) Then
            For k = 1 To 2
                mytemp = myAr(i, k)
                myAr(i, k) = myAr(j, k)
                myAr(j, k) = mytemp
            Next k
        End If
    Next j
Next i
    
End Sub

 

[CARBOB]

Stephen,
I still get an variable not defined at q = Range("B1")

 

[Stephen_Tsui]

I've defined it, see if it is what you need, thx.

Sub Drawing() 

Dim myAr() As Variant 
Dim myRang As Range 
Dim q As Integer 
Dim ResultRow As Integer 

q = Range("B1") ' How many are picked 

Set myRang = Range(Range("A1"), Range("A65536").End(xlUp)) 'Number of people Set

ReDim myAr(myRang.Rows.Count, 1 To 2) 

For i = 1 To myRang.Rows.Count 
    myAr(i, 1) = myRang.Cells(i) 
    Randomize 
    myAr(i, 2) = Rnd() 
Next i 

BubbleSort myAr 

ResultRow = Range("c65536").End(xlUp).Offset(1).Row 

For i = 1 To q 
    Cells(ResultRow, i + 2) = myAr(i, 1) 
Next i 

End Sub 

Sub BubbleSort(myAr() As Variant) 

For i = 1 To UBound(myAr) - 1 
    For j = i + 1 To UBound(myAr) 
        If myAr(i, 2) > myAr(j, 2) Then 
            For k = 1 To 2 
                mytemp = myAr(i, k) 
                myAr(i, k) = myAr(j, k) 
                myAr(j, k) = mytemp 
            Next k 
        End If 
    Next j 
Next i 
    
End Sub

 

[CARBOB]

Still getting an compile error here For i = 1 To myRang.Rows.Count