Combination Help

eyal8r

Board Regular
Joined
Mar 18, 2002
Messages
179
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!
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
I gave this a try, and it seems to be close ...

Code:
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
 
Upvote 0
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.
Code:
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
ABCDEF
1Clark3ClarkLoisLana
2LoisClarkLoisLex
3LanaClarkLoisChloe
4LexClarkLoisMartha
5ChloeClarkLanaLex
6MarthaClarkLanaChloe
7ClarkLanaMartha
8ClarkLexChloe
9ClarkLexMartha
10ClarkChloeMartha
11LoisLanaLex
12LoisLanaChloe
13LoisLanaMartha
14LoisLexChloe
15LoisLexMartha
16LoisChloeMartha
17LanaLexChloe
18LanaLexMartha
19LanaChloeMartha
20LexChloeMartha
21
Sheet2


Hope this helps
PGC

EDIT: The code now gets the inputs automatically.
 
Upvote 0
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!
 
Upvote 0
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...
 
Upvote 0
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:

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

Hope this helps
PGC
 
Upvote 0
Can this macro be adapted to generate combinations for numbers setup like this?

333333
222222
111111
000000
 
Upvote 0
Hi CARBOB

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

Code:
For i = iElement To UBound(vElements)

to

Code:
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?

Code:
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
ABCDEF
103000
21001
32002
4010
5011
6012
7020
8021
9022
10100
11101
12102
13110
14111
15112
16120
17121
18122
19200
20201
21202
22210
23211
24212
25220
26221
27222
28
Sheet1
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top