VBA, lottery total combinations could be ended with sums (only sum list)

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
Office Version
  1. 2010
Hello,

I am looking for how many total combinations could be made with sums. For example lottery EuroMillions has 50 numbers out of that 5 numbers is drawn so far formula =COMBIN(50,5) there are 2.118.760 total combinations can be made.

Now say for example if starting number "1" is fixed I mean if played numbers with only so it will generate =COMBIN(49,4) = 211.876 combinations now these combinations have sum from 15 to 240.

I am looking answer how will be the distribution of 211.876 combinations with each sum (15 to 240) I just want VBA that can list total combination with each of the sum

Please see the example below for example with sum 15 only will be possibly 1 combination with sum 15 = 1,2,3,4,5 and need to find till sum 240 ( only sum list )

SumPlaying Fix Num=1
SumCombinations
15​
1
16​
17​
18​
19​
20​
21​
22​
23​
24​
25​
26​
27​
28​
29​
30​
31​
32​
33​
34​
35​
36​
37​
38​
39​
40​
41​
42​
43​
44​
45​
46​
47​
48​
49​
50​
51​
52​
53​
54​
55​
56​
57​
58​
59​
60​
61​
62​
63​
64​
65​
66​
67​
68​
69​
70​
71​
72​
73​
74​
75​
76​
77​
78​
79​
80​
81​
82​
83​
84​
85​
86​
87​
88​
89​
90​
91​
92​
93​
94​
95​
96​
97​
98​
99​
100​
101​
102​
103​
104​
105​
106​
107​
108​
109​
110​
111​
112​
113​
114​
115​
116​
117​
118​
119​
120​
121​
122​
123​
124​
125​
126​
127​
128​
129​
130​
131​
132​
133​
134​
135​
136​
137​
138​
139​
140​
141​
142​
143​
144​
145​
146​
147​
148​
149​
150​
151​
152​
153​
154​
155​
156​
157​
158​
159​
160​
161​
162​
163​
164​
165​
166​
167​
168​
169​
170​
171​
172​
173​
174​
175​
176​
177​
178​
179​
180​
181​
182​
183​
184​
185​
186​
187​
188​
189​
190​
191​
192​
193​
194​
195​
196​
197​
198​
199​
200​
201​
202​
203​
204​
205​
206​
207​
208​
209​
210​
211​
212​
213​
214​
215​
216​
217​
218​
219​
220​
221​
222​
223​
224​
225​
226​
227​
228​
229​
230​
231​
232​
233​
234​
235​
236​
237​
238​
239​
240​

Thank you all.

I am using Excel 2000

Regards,
Moti
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
motilulla said:
I am using Excel 2000
Click to expand...

Really?!! Excel 2000 was part of Office 2000, which was released in 1999(!). I wonder if you mean a version of Excel 365 that is identified as version (build?) 2000.

No matter....

motilulla said:
Now say for example if starting number "1" is fixed I mean if played numbers with only so it will generate =COMBIN(49,4) = 211.876 combinations now these combinations have sum from 15 to 240.
Click to expand...

The distribution of sums will vary depending on the first "fixed" number.

The following produces the distribution of sums for all COMBIN(n,5) combinations. It runs in less than 0.2 sec on my computer. The output is written into columns A:B.

VBA Code: 
Sub doit()
' output into A:B
Const n As Long = 50
Const minSum As Long = 1 + 2 + 3 + 4 + 5
Const maxSum As Long = 5 * n - (1 + 2 + 3 + 4)
Dim res(minSum To maxSum, 1 To 2) As Long
Dim i As Long, i1 As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, sm As Long, ncombo As Long
Dim st As Double, dt As Double
For i = minSum To maxSum: res(i, 1) = i: Next
st = Timer
For i1 = 1 To n - 4
For i2 = i1 + 1 To n - 3
For i3 = i2 + 1 To n - 2
For i4 = i3 + 1 To n - 1
For i5 = i4 + 1 To n
    ncombo = ncombo + 1
    sm = i1 + i2 + i3 + i4 + i5
    res(sm, 2) = res(sm, 2) + 1
Next i5, i4, i3, i2, i1
dt = Timer - st
Range("a1:b" & maxSum - minSum + 1) = res
MsgBox ncombo & "    " & Format(dt, "0.000000") & " sec"
End Sub

The following produces the distribution of sums for all COMBIN(n-4,4) combinations, after you choose the first "fixed" number. The output is written into columns D:E.

VBA Code: 
Sub doitFix1()
' output into C:D
Const i1 As Long = 25  ' *** YOU CHOOSE ***
Const n As Long = 50
Const minSum As Long = 1 + 2 + 3 + 4 + 5
Const maxSum As Long = 5 * n - (1 + 2 + 3 + 4)
Dim res(minSum To maxSum, 1 To 2) As Long
Dim nlist(1 To n) As Long
Dim i As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, sm As Long, ncombo As Long
Dim r As Long, lastSum As Long
Dim st As Double, dt As Double
For i = minSum To maxSum: res(i, 1) = i: Next

' combo of first n-1 numbers, excluding i1
For i = 1 To n: nlist(i) = i: Next
nlist(i1) = nlist(n)
st = Timer
For i2 = 1 To n - 4
For i3 = i2 + 1 To n - 3
For i4 = i3 + 1 To n - 2
For i5 = i4 + 1 To n - 1
    ncombo = ncombo + 1
    sm = i1 + nlist(i2) + nlist(i3) + nlist(i4) + nlist(i5)
    res(sm, 2) = res(sm, 2) + 1
Next i5, i4, i3, i2
dt = Timer - st

' limit output to range of nonzero sums
[d1] = i1
For lastSum = maxSum To minSum - 1 Step -1
    If res(lastSum, 2) <> 0 Then Exit For
Next
For i = minSum To maxSum - 1
    If res(i, 2) <> 0 Then Exit For
Next
r = 1
For i = i To lastSum
    r = r + 1
    Cells(r, "d") = res(i, 1)
    Cells(r, "e") = res(i, 2)
Next
MsgBox ncombo & "    " & Format(dt, "0.000000") & " sec"
End Sub
 
Upvote 0
joeu2004 said:
Really?!! Excel 2000 was part of Office 2000, which was released in 1999(!). I wonder if you mean a version of Excel 365 that is identified as version (build?) 2000.

No matter....



The distribution of sums will vary depending on the first "fixed" number.

The following produces the distribution of sums for all COMBIN(n,5) combinations. It runs in less than 0.2 sec on my computer. The output is written into columns A:B.

VBA Code: 
Sub doit()
' output into A:B
Const n As Long = 50
Const minSum As Long = 1 + 2 + 3 + 4 + 5
Const maxSum As Long = 5 * n - (1 + 2 + 3 + 4)
Dim res(minSum To maxSum, 1 To 2) As Long
Dim i As Long, i1 As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, sm As Long, ncombo As Long
Dim st As Double, dt As Double
For i = minSum To maxSum: res(i, 1) = i: Next
st = Timer
For i1 = 1 To n - 4
For i2 = i1 + 1 To n - 3
For i3 = i2 + 1 To n - 2
For i4 = i3 + 1 To n - 1
For i5 = i4 + 1 To n
    ncombo = ncombo + 1
    sm = i1 + i2 + i3 + i4 + i5
    res(sm, 2) = res(sm, 2) + 1
Next i5, i4, i3, i2, i1
dt = Timer - st
Range("a1:b" & maxSum - minSum + 1) = res
MsgBox ncombo & "    " & Format(dt, "0.000000") & " sec"
End Sub

The following produces the distribution of sums for all COMBIN(n-4,4) combinations, after you choose the first "fixed" number. The output is written into columns D:E.

VBA Code: 
Sub doitFix1()
' output into C:D
Const i1 As Long = 25  ' *** YOU CHOOSE ***
Const n As Long = 50
Const minSum As Long = 1 + 2 + 3 + 4 + 5
Const maxSum As Long = 5 * n - (1 + 2 + 3 + 4)
Dim res(minSum To maxSum, 1 To 2) As Long
Dim nlist(1 To n) As Long
Dim i As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, sm As Long, ncombo As Long
Dim r As Long, lastSum As Long
Dim st As Double, dt As Double
For i = minSum To maxSum: res(i, 1) = i: Next

' combo of first n-1 numbers, excluding i1
For i = 1 To n: nlist(i) = i: Next
nlist(i1) = nlist(n)
st = Timer
For i2 = 1 To n - 4
For i3 = i2 + 1 To n - 3
For i4 = i3 + 1 To n - 2
For i5 = i4 + 1 To n - 1
    ncombo = ncombo + 1
    sm = i1 + nlist(i2) + nlist(i3) + nlist(i4) + nlist(i5)
    res(sm, 2) = res(sm, 2) + 1
Next i5, i4, i3, i2
dt = Timer - st

' limit output to range of nonzero sums
[d1] = i1
For lastSum = maxSum To minSum - 1 Step -1
    If res(lastSum, 2) <> 0 Then Exit For
Next
For i = minSum To maxSum - 1
    If res(i, 2) <> 0 Then Exit For
Next
r = 1
For i = i To lastSum
    r = r + 1
    Cells(r, "d") = res(i, 1)
    Cells(r, "e") = res(i, 2)
Next
MsgBox ncombo & "    " & Format(dt, "0.000000") & " sec"
End Sub
Click to expand...
Wow! joeu2004, hats off to you that is exactly what I wanted superb!! This macro run and got total sum result 211.876 in the "0,023438 sec"

And thank you for adding additionally code, which is giving how many combinations, could be with each of sum from 15 to 240 that is fantastic!! This macro run and got total sum result 2.118.760 in the "0,101563 sec"

I am grateful to you for your kind help, best of luck

Kind Regards
Moti :)
 
Upvote 0
joeu2004 said:
@motilulla.... You're welcome. FYI, there is no need for "res" to be 2-dimensional in sub doitFix1.
Click to expand...
Hello joeu2004, please confirm do you mean the following part is no need can be removed?

VBA Code: 
For i = minSum To maxSum - 1
    If res(i, 2) <> 0 Then Exit For
Next

Please one more favour can you modify or make a new macro in which I can get sum list fixing 2 numbers for example in the position-1 number "1" and in the position-2 number "2" or any 2 numbers like "1 and 4", "5 and 6"

Say for example fixing 2 numbers in 1st and 2nd position "1 and 2" the min and max sum will be changed adding in it 3 more numbers like fixing-1and2 adding in it +3+4+5 = 15 min sum, 1and2 adding in it +48+49+50 = 150 max sum

Please could you take a look and advice?

Kind Regards
Moti
 
Upvote 0
motilulla said:
do you mean the following part is no need can be removed?
Click to expand...

No. I mean that in "doitFix1" (but not in "doit"), Dim res(minSum To maxSum, 1 To 2) can be changed to Dim res(minSum To maxSum), among other changes. The improved procedure is:

Rich (BB code): 
Sub doitFix1()
' output into D:E
Const i1 As Long = 25  ' *** YOU CHOOSE ***
Const n As Long = 50
Const minSum As Long = 1 + 2 + 3 + 4 + 5
Const maxSum As Long = 5 * n - (1 + 2 + 3 + 4)
Dim res(minSum To maxSum) As Long
Dim nlist(1 To n) As Long
Dim i As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, sm As Long, ncombo As Long
Dim r As Long, lastSum As Long
Dim st As Double, dt As Double

' combo of first n-1 numbers, excluding i1
For i = 1 To n: nlist(i) = i: Next
nlist(i1) = nlist(n)
st = Timer
For i2 = 1 To n - 4
For i3 = i2 + 1 To n - 3
For i4 = i3 + 1 To n - 2
For i5 = i4 + 1 To n - 1
    ncombo = ncombo + 1
    sm = i1 + nlist(i2) + nlist(i3) + nlist(i4) + nlist(i5)
    res(sm) = res(sm) + 1
Next i5, i4, i3, i2
dt = Timer - st

' limit output to range of nonzero sums
[d1] = i1
For lastSum = maxSum To minSum - 1 Step -1
    If res(lastSum) <> 0 Then Exit For
Next
For i = minSum To maxSum - 1
    If res(i) <> 0 Then Exit For
Next
r = 1
For i = i To lastSum
    r = r + 1
    Cells(r, "d") = i
    Cells(r, "e") = res(i)
Next
MsgBox ncombo & "    " & Format(dt, "0.000000") & " sec"
End Sub

-----

motilulla said:
Please one more favour can you modify or make a new macro in which I can get sum list fixing 2 numbers
Click to expand...

I'll follow up later. Things to do; places to be.
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Weighted lottery help?
2
Replies
14
Views
4K
bebo021999
B
N
  • Solved
Sum total between bottle refill times
Replies
5
Views
532
Georgiboy
Georgiboy
S
  • Solved
VBA: All combinations that sum between two numbers - too much processing blows up
Replies
4
Views
1K
solutelan
S
M
  • Solved
VBA generate 5_50 combinations from (column A) list.
Replies
3
Views
386
StephenCrump
S
P
  • Solved
Calculate based on date sum of hours based on date
2
Replies
15
Views
755
psycoperl
P

Forum statistics

Threads
1,223,625
Messages
6,173,395
Members
452,514
Latest member
cjkelly15

Share this page

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