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!

 

[golfbum71]

I gave this a try, and it seems to be close ...

Sub StinkerMsg()
MsgBox "Mine stunk...use the great stuff below..."
End Sub

Edited to allow you to see the great stuff below without having to wade through my poor attempts...

Cheers,
Geoff

 

[pgc01]

Hi

This is a code to generate combinations (without error checking).

- It gets the elements to group in A1, down (in the example A1:A6)
- It gets how many elements per group in B1 (in the example 3)

Remarks:
. The elements don't have to be numbers, can be strings
. The results are writen starting C1 to the right and down
. p + 1 columns starting C are cleared at the beggining

Please test it.

Sub Combinations()
Dim rRng As Range, p As Integer
Dim vElements, lRow As Long, vresult As Variant

Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of numbers 
p = Range("B1").Value ' How many are picked 

vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Columns("C").Resize(, p + 1).Clear
Call CombinationsNP(vElements, p, vresult, lRow, 1, 1)
End Sub

Sub CombinationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer

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
End Sub

Example:

Book1
	A	B	C	D	E	F
1	Clark	3	Clark	Lois	Lana
2	Lois		Clark	Lois	Lex
3	Lana		Clark	Lois	Chloe
4	Lex		Clark	Lois	Martha
5	Chloe		Clark	Lana	Lex
6	Martha		Clark	Lana	Chloe
7			Clark	Lana	Martha
8			Clark	Lex	Chloe
9			Clark	Lex	Martha
10			Clark	Chloe	Martha
11			Lois	Lana	Lex
12			Lois	Lana	Chloe
13			Lois	Lana	Martha
14			Lois	Lex	Chloe
15			Lois	Lex	Martha
16			Lois	Chloe	Martha
17			Lana	Lex	Chloe
18			Lana	Lex	Martha
19			Lana	Chloe	Martha
20			Lex	Chloe	Martha
21
Sheet2

Hope this helps
PGC

EDIT: The code now gets the inputs automatically.

 

[eyal8r]

WOW! WORKS GREAT!!! THANK YOU!!!! This is EXACTLY what I've been looking for! I had 10 numbers, but needed 5 picks- it ran all the possible combos, no repeats! Awesome. I'm going to try a larger set and post back to you if there's any problems. YOU ROCK!

 

[eyal8r]

I don't know how to do this- but I'm sure there's a way to write the VB so that it automatically detects the desired Range in Col A. You'd still need to set the numbers of picks you need tho...

 

[pgc01]

To do it automatically

- write your numbers in A1, down with no gaps (as in the example)
- write the value of p in B1

Replace the first 2 assigning statements by:

Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked

Hope this helps
PGC

 

[CARBOB]

Can this macro be adapted to generate combinations for numbers setup like this?

333333
222222
111111
000000

 

[CARBOB]

Can this macro be adapted to generate combinations for numbers setup like this?

333333
222222
111111
000000

Ex:
333333
333332
333323
333331
333330

 

[pgc01]

Hi CARBOB

It seems you want permutations with repetition. In that case just change

For i = iElement To UBound(vElements)

to

For i = 1 To UBound(vElements)

also, for the sake of coherence, change in the names of the subs Combinations to Permutations.

Is this what you want?

Sub Permutations()
Dim rRng As Range, p As Integer
Dim vElements, lRow As Long, vresult As Variant

Set rRng = Range("A1", Range("A1").End(xlDown)) ' The set of numbers
p = Range("B1").Value ' How many are picked

vElements = Application.Index(Application.Transpose(rRng), 1, 0)
ReDim vresult(1 To p)
Columns("C").Resize(, p + 1).Clear
Call PermutationsNP(vElements, p, vresult, lRow, 1, 1)
End Sub

Sub PermutationsNP(vElements As Variant, p As Integer, vresult As Variant, lRow As Long, iElement As Integer, iIndex As Integer)
Dim i As Integer

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

Book1
	A	B	C	D	E	F
1	0	3	0	0	0
2	1		0	0	1
3	2		0	0	2
4			0	1	0
5			0	1	1
6			0	1	2
7			0	2	0
8			0	2	1
9			0	2	2
10			1	0	0
11			1	0	1
12			1	0	2
13			1	1	0
14			1	1	1
15			1	1	2
16			1	2	0
17			1	2	1
18			1	2	2
19			2	0	0
20			2	0	1
21			2	0	2
22			2	1	0
23			2	1	1
24			2	1	2
25			2	2	0
26			2	2	1
27			2	2	2
28
Sheet1

 

[Stephen_Tsui]

This Programme can randomly draw from diff combination

Hi Man:

Here is a programme can randomly draw from different combination see if is useful to u.

Sub Drawing()

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

p = Range("B1") 'P is number of people

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