Lottery combinations

[Kobus]

Question1: How do I calculate the number of combinations in a 49 number 6
ball lottery where every combinations adds up to say: 138. Sum total 279,
for instance, can only happen once.
Question2: How do I generate these results?

 

[Mike H]

Hi,

An interesting Sunday afternoon exercise. Firstly, you will need to be quite
wealthy to cover all of the 156004 combinations that add up to 138. To
generate them use an empty worksheet and put the numbers 1 - 49 in column A
starting in A1. Then right click the sheet tab, view code and paste this in
and run it and then make a cup of tea because it took several minutes to run
on my PC.

P.S. It would be unwise to press the print button unless you have lots of
paper!!

Sub thelottery()
Count = 1
col = 2
lastrow = Range("A65536").End(xlUp).Row
Set myRange = Range("A1:A" & lastrow)
For Each c In myRange
numbers = numbers + 1
Next
Dim n(49)
For p = 1 To numbers
n(p) = Cells(p, 1).Value
Next
For i = 1 To numbers
For j = 1 To numbers
If j <= i Then GoTo 100
For k = 1 To numbers
If k <= j Then GoTo 200
For l = 1 To numbers
If l <= k Then GoTo 300
For m = 1 To numbers
If m <= l Then GoTo 400
For o = 1 To numbers
If o <= m Then GoTo 500
For x = 1 To numbers
If i = x Then firstno = n(x)
Next
For x = 1 To numbers
If j = x Then secondno = n(x)
Next
For x = 1 To numbers
If k = x Then thirdno = n(x)
Next
For x = 1 To numbers
If l = x Then fourthno = n(x)
Next
For x = 1 To numbers
If m = x Then fifthno = n(x)
Next
For x = 1 To numbers
If o = x Then sixthno = n(x)
Next
If firstno + secondno + thirdno + fourthno + fifthno +
sixthno = 138 Then
Cells(Count, col).Value = firstno & "," & secondno &
"," & thirdno & "," & fourthno & "," & fifthno & "," & sixthno
If Count = 65536 Then
Count = 1
col = col + 1
Else
Count = Count + 1
End If
End If
500 Next
400 Next
300 Next
200 Next
100 Next

Next
Cells(1, 8).Value = Count - 1
End Sub


Mike

 

[Kobus]

There is a sintex error, with some hard work on my side I will eventually
figure it out. You guys are just lightyears ahead with your VB knowledge!!
Thanks

 

[Mike H]

Hi,

There's no syntax error but what has happened in posting is 2 lines have
wrapped

this is one line
If firstno + secondno + thirdno + fourthno + fifthno + sixthno = 138 Then


and these 2 should be on one line
Cells(Count, col).Value = firstno & "," & secondno & "," & thirdno & "," &
fourthno & "," & fifthno & "," & sixthno

Mike

 

[Kobus]

Yes, I figured it out, but thanks again, now I will have to work on some
probabilities to reduce the 256k options

 

[Meebers]

What about a 6 ball 52 number combo. changes = Dim n(52) and ?

 

[Kobus]

No, I would rather want a 7 ball 49 combo. Our lottery runs the 7th ball as
a bonus ball. That might reduce the odds, but I would need the experts to
edit it for me. I am making the attempt now though

 

[Mike H]

Hi,

To calculate all the combinations in a 52 number lottery then alter the
array dimension as you note to
Dim n(52)
and then put all 52 numbers in column A and be prepared for a long wait.

But remember this was written to specifically to only produce combinations
that add up to 138 as requested by the OP and more usually people would want
to all combinations of a set of numbers.

The code below has been edited to produce all the combinations of a set of
numbers so if you want to (say) produce all the combinations of 10 numbers
put those numbers in column A and run the code, For example these numbers in
column A but you can put as many as you like up to 52

1
2
3
45
47
48
49
52

Would produce the 28 combinations possible.

HTH Mike


Sub thelottery()
Application.ScreenUpdating = False
Count = 1
col = 2
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myRange = Range("A1:A" & lastrow)
For Each c In myRange
numbers = numbers + 1
Next
Dim n(52)
For p = 1 To numbers
n(p) = Cells(p, 1).Value
Next
For i = 1 To numbers
For j = 1 To numbers
If j <= i Then GoTo 100
For k = 1 To numbers
If k <= j Then GoTo 200
For l = 1 To numbers
If l <= k Then GoTo 300
For m = 1 To numbers
If m <= l Then GoTo 400
For o = 1 To numbers
If o <= m Then GoTo 500
For x = 1 To numbers
If i = x Then firstno = n(x)
Next
For x = 1 To numbers
If j = x Then secondno = n(x)
Next
For x = 1 To numbers
If k = x Then thirdno = n(x)
Next
For x = 1 To numbers
If l = x Then fourthno = n(x)
Next
For x = 1 To numbers
If m = x Then fifthno = n(x)
Next
For x = 1 To numbers
If o = x Then sixthno = n(x)
Next
Cells(Count, col).Value = firstno & "," & secondno &
"," & thirdno & "," & fourthno & "," & fifthno & "," & sixthno
If Count = 65536 Then
total = total + Count
Count = 1
col = col + 1
Else
Count = Count + 1
End If

500 Next
400 Next
300 Next
200 Next
100 Next
Next
Cells(1, 8).Value = (total + Count) - 1
Application.ScreenUpdating = True
End Sub

 

[Mike H]

Hi,

As you will see the code works with 6-deep nested if loops so to produce
all combinations of 7 numbers you need to nest 1 deeper like this. Note that
7 deep is the limits of Excel's capability.

I highlighted the additional code with '****

Sub thelottery()
Application.ScreenUpdating = False
Count = 1
col = 2
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myRange = Range("A1:A" & lastrow)
For Each c In myRange
numbers = numbers + 1
Next
Dim n(49)
For p = 1 To numbers
n(p) = Cells(p, 1).Value
Next
For i = 1 To numbers
For j = 1 To numbers
If j <= i Then GoTo 100
For k = 1 To numbers
If k <= j Then GoTo 200
For l = 1 To numbers
If l <= k Then GoTo 300
For m = 1 To numbers
If m <= l Then GoTo 400
For o = 1 To numbers
If o <= m Then GoTo 500
'***
For p = 1 To numbers
If p <= o Then GoTo 600
'****

For x = 1 To numbers
If i = x Then firstno = n(x)
Next
For x = 1 To numbers
If j = x Then secondno = n(x)
Next
For x = 1 To numbers
If k = x Then thirdno = n(x)
Next
For x = 1 To numbers
If l = x Then fourthno = n(x)
Next
For x = 1 To numbers
If m = x Then fifthno = n(x)
Next
For x = 1 To numbers
If o = x Then sixthno = n(x)
Next
'***
For x = 1 To numbers
If p = x Then seventhno = n(x)
Next
'***
Cells(Count, col).Value = firstno & "," & secondno &
"," & thirdno & "," & fourthno & "," & fifthno & "," & sixthno & "," &
seventhno
If Count = 65536 Then
total = total + Count
Count = 1
col = col + 1
Else
Count = Count + 1
End If

600 Next
500 Next
400 Next
300 Next
200 Next
100 Next
Next
Cells(1, 8).Value = (total + Count) - 1
Application.ScreenUpdating = True
End Sub

 

[Mike H]

Note that 7 deep is the limits of Excel's capability.

Which upon searching I now believe is not true and applies to nested
worksheet if's and note code which (I think) can be nested as deeply as you
want but I stand correction on this.

Mike

 

[Meebers]

Thanks Mike....great Job.!

Hi,

To calculate all the combinations in a 52 number lottery then alter the
array dimension as you note to
Dim n(52)
and then put all 52 numbers in column A and be prepared for a long wait.

But remember this was written to specifically to only produce combinations
that add up to 138 as requested by the OP and more usually people would
want
to all combinations of a set of numbers.

The code below has been edited to produce all the combinations of a set of
numbers so if you want to (say) produce all the combinations of 10 numbers
put those numbers in column A and run the code, For example these numbers
in
column A but you can put as many as you like up to 52

1
2
3
45
47
48
49
52

Would produce the 28 combinations possible.

HTH Mike


Sub thelottery()
Application.ScreenUpdating = False
Count = 1
col = 2
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set myRange = Range("A1:A" & lastrow)
For Each c In myRange
numbers = numbers + 1
Next
Dim n(52)
For p = 1 To numbers
n(p) = Cells(p, 1).Value
Next
For i = 1 To numbers
For j = 1 To numbers
If j <= i Then GoTo 100
For k = 1 To numbers
If k <= j Then GoTo 200
For l = 1 To numbers
If l <= k Then GoTo 300
For m = 1 To numbers
If m <= l Then GoTo 400
For o = 1 To numbers
If o <= m Then GoTo 500
For x = 1 To numbers
If i = x Then firstno =
n(x)
Next
For x = 1 To numbers
If j = x Then secondno =
n(x)
Next
For x = 1 To numbers
If k = x Then thirdno =
n(x)
Next
For x = 1 To numbers
If l = x Then fourthno =
n(x)
Next
For x = 1 To numbers
If m = x Then fifthno =
n(x)
Next
For x = 1 To numbers
If o = x Then sixthno =
n(x)
Next
Cells(Count, col).Value = firstno & "," & secondno
&
"," & thirdno & "," & fourthno & "," & fifthno & "," & sixthno
If Count = 65536 Then
total = total + Count
Count = 1
col = col + 1
Else
Count = Count + 1
End If

500 Next
400 Next
300 Next
200 Next
100 Next
Next
Cells(1, 8).Value = (total + Count) - 1
Application.ScreenUpdating = True
End Sub

 

[Mike H]

Your most welcome

Thanks Mike....great Job.!

 

[Dana DeLouis]

How do I calculate the number of combinations in a 49 number 6

ball lottery where every combinations adds up to say: 138

Hi. If interested, there are non Brute-Force methods to calculate the total
combinations without actually generating each subset.
For example, it takes about 0.4 seconds to generate the totals of each
combination of 6.
We can quickly verify your total:

? SubsetSums(49,6,138)
156,004

Which checks with your count.

Just for fun, the largest count of subset (6) sums is 150.
n=49
s=6
?(1 + n)*s /2
150

Because it's already calculated, counting the number of subsets (6) that
total 150 takes 0 seconds.
?SubsetSums(49,6,150)
165,772

Just a programming idea.
This part:

For j = 1 To numbers
If j <= i Then GoTo 100

Is usually written something like this:

For i = 1 to 44
For j= i+1 to 45
For k = j+1 to 46
etc...


Again, an interesting subject. :>)

 

[JE McGimpsey]

Just for fun, another way, perhaps a bit faster:

Public Sub test()
Dim vArr As Variant

vArr = PickSixToTotal(52, 138)
With ActiveSheet.Range("A1")
If IsArray(vArr) Then
With .Resize(UBound(vArr, 1), UBound(vArr, 2))
.Clear
.Value = vArr
End With
Else
.Value = vArr
End If
End With
End Sub


Public Function PickSixToTotal( _
ByVal MaxNum As Long, _
ByVal Target As Long, _
Optional ByVal MaxRows As Long = 50000#) As Variant

Const sp As String = ","

Dim vArr As Variant
Dim nCol As Long
Dim nCount As Long
Dim nCum As Long
Dim n1 As Long, n2 As Long, n3 As Long
Dim n4 As Long, n5 As Long, n6 As Long
Dim n12 As Long, n123 As Long, n1234 As Long

If Target < 21 Or Target > (6 * MaxNum - 15) Then
PickSixToTotal = "Target Out of Range"
Exit Function
End If
nCol = 1
nCount = 1
ReDim vArr(1 To MaxRows, 1 To nCol)
For n1 = 1 To MaxNum - 5
If (6 * n1 + 15) <= Target And _
(n1 + 5 * MaxNum - 10) >= Target Then
For n2 = n1 + 1 To MaxNum - 4
n12 = n1 + n2
If (n1 + 5 * n2 + 10) <= Target And _
(n12 + 4 * MaxNum - 6) >= Target Then
For n3 = n2 + 1 To MaxNum - 3
n123 = n12 + n3
If (n12 + 4 * n3 + 6) <= Target And _
(n123 + 3 * MaxNum - 3) >= Target Then
For n4 = n3 + 1 To MaxNum - 2
n1234 = n123 + n4
If (n123 + 3 * n4 + 3) <= Target And _
(n1234 + 2 * MaxNum - 1) >= Target Then
For n5 = n4 + 1 To MaxNum - 1
n6 = Target - n1234 - n5
If n6 <= n5 Then Exit For
If n6 <= MaxNum Then
vArr(nCount, nCol) = n1 & sp & n2 & sp & _
n3 & sp & n4 & sp & n5 & sp & n6
If nCount = MaxRows Then
nCol = nCol + 1
nCount = 1
ReDim Preserve vArr(1 To MaxRows, 1 To nCol)
Else
nCount = nCount + 1
End If
End If
Next n5
End If
Next n4
End If
Next n3
End If
Next n2
End If
Next n1
PickSixToTotal = vArr
End Function

 

[Mike H]

Hi,

Thanks for your comments on my code. I went for the brute-force approach
because the OP wanted a listing of combinations that added up to 138 because;
I suspect, of some sort of cunning plan to win the lottery.

The method used in the code is I agree somewhat ponderous but in my defence
it was originally written for another lottery syndicate when they wanted to
bet on every possible combination of 10 numbers but couldn't think of a way
to work out the combinations manually; ensuring they didn't miss any, and
it's actually very quick when dealing with small subsets.

Having looked at this combination and subsets thing as a method of winning
the lottery my standard advice remains this and is guaranteed to give you a
win. Pick 6 numbers and stick with them and one day you will win. The trick
however is ensuring you are still around when those numbers come in

Mike

 

[Mike H]

Just for fun, another way, perhaps a bit faster:


Actually no not a 'bit' faster it's a walkover, seconds as opposed to
several minutes. Excellent.

Mike

 

[Kobus]

Certainly it was a feeble attempt to weaken the odds. Question was why a
draw totaling 138 was so frequent. It beats 150 for instance which should be
more frequent. If you are going to pick 6 numbers and live with it forever
then choose the best odds. Backgammon is won that way.