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

[motilulla]

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 )

Sum	Playing Fix Num=1
Sum	Combinations
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

 

[Marc L]

(removed)

 

[Marc L]

make a new macro in which I can get sum list fixing 2 numbers

According to your previous thread closed to this one - it's time to learn ! - so the last VBA demonstration to paste to the top of the worksheet module :​

Const K = 5
  Dim N&, R&, V(), W

Sub SumCombinate(L&, S&, T$, Optional P&)
    Dim A&, C$
    For P = P To UBound(W) + N * (P = 0)
        A = S + W(P):  C = T & W(P)
        If L < K Then SumCombinate L + 1, A, C & " ", P + 1 Else R = R + 1: V(R, 0) = A: V(R, 1) = C
    Next
End Sub

Sub Demo1()
        Dim M$, S&, X
    Do
            M = InputBox(vbLf & M & vbLf & vbLf & "Space delimited :", "Fix number(s)"):  If M = "" Then Exit Sub
            X = Split(Application.Trim(M))
        If UBound(X) >= K - 2 Then
            M = "1 to " & K - 1 & " numbers only !":  Beep
        Else
                M = "":  S = 0:  W = [COLUMN(A:AX)]
            For R = 0 To UBound(X)
                If X(R) < 1 Or X(R) > 50 Then M = "Number(s) between 1 and 50 only !": Beep: Exit For
                S = S + X(R):  W(X(R)) = False
            Next
        End If
    Loop Until M = ""
        [A1].CurrentRegion.Offset(1).Clear
        ReDim V(1 To Rows.Count, 1)
        N = K - UBound(X) - 2:  R = 0:  W = Filter(W, False, False)
        SumCombinate UBound(X) + 2, S, Join(X) & " "
    If R Then
        With [A2].Resize(R, 2)
            .IndentLevel = 2
            .Columns(1).HorizontalAlignment = xlRight
            .Value2 = V
            .Sort .Cells(1), 1, Header:=2
        End With
    End If
        Erase V, W
End Sub

 

[Marc L]

According to previous post Demo1 VBA procedure :​

• Correction :
  
  The codeline If UBound(X) >= K - 2 must be obviously If UBound(X) >= K - 1
  
  
• Optimization :
  
  The codeline ReDim V(1 To Rows.Count, 1) should be ReDim V(1 To Application.Combin(50 - UBound(X) - 1, K - UBound(X) - 1), 1) …

 

[Marc L]

As it's better with the screen updating desactivated so finally :​

Const K = 5
  Dim N&, R&, V(), W

Sub SumCombinate(L&, S&, T$, Optional P&)
    Dim A&, C$
    For P = P To UBound(W) + N * (P = 0)
        A = S + W(P):  C = T & W(P)
        If L < K Then SumCombinate L + 1, A, C & " ", P + 1 Else R = R + 1: V(R, 0) = A: V(R, 1) = C
    Next
End Sub

Sub Demo1()
        Dim M$, S&, X
    Do
            M = InputBox(vbLf & M & vbLf & vbLf & "Space delimited :", "Fix number(s)"):  If M = "" Then Exit Sub
            X = Split(Application.Trim(M))
        If UBound(X) >= K - 1 Then
            M = "1 to " & K - 1 & " numbers only !":  Beep
        Else
                M = "":  S = 0:  W = [COLUMN(A:AX)]
            For R = 0 To UBound(X)
                If X(R) < 1 Or X(R) > 50 Then M = "Number(s) between 1 and 50 only !": Beep: Exit For
                S = S + X(R):  W(X(R)) = False
            Next
        End If
    Loop Until M = ""
        [A1].CurrentRegion.Offset(1).Clear
        ReDim V(1 To Application.Combin(50 - UBound(X) - 1, K - UBound(X) - 1), 1)
        N = K - UBound(X) - 2:  R = 0:  W = Filter(W, False, False)
        SumCombinate UBound(X) + 2, S, Join(X) & " "
    If R Then
            Application.ScreenUpdating = False
        With [A2].Resize(R, 2)
            .IndentLevel = 2
            .Columns(1).HorizontalAlignment = xlRight
            .Value2 = V
            .Sort .Cells(1), 1, Header:=2
        End With
            Application.ScreenUpdating = True
    End If
        Erase V, W
End Sub

 

[Marc L]

To count only the number of combinations by sum a new VBA procedure as last demonstration to paste to the top of the worksheet module :​

Const K = 5
  Dim oDic As Object, N&, W

Sub CountSumCombinate(L&, S&, Optional P&)
    Dim A&
    For P = P To UBound(W) + N * (P = 0)
        A = S + W(P):  If L < K Then CountSumCombinate L + 1, A, P + 1 Else oDic(A) = oDic(A) + 1
    Next
End Sub

Sub Demo2()
        Dim C&, M$, S&, X
    Do
            M = InputBox(vbLf & M & vbLf & vbLf & "Space delimited :", "Fix number(s)"):  If M = "" Then Exit Sub
            X = Split(Application.Trim(M))
        If UBound(X) >= K - 1 Then
            M = "1 to " & K - 1 & " numbers only !":  Beep
        Else
                M = "":  S = 0:  W = [COLUMN(A:AX)]
            For C = 0 To UBound(X)
                If X(C) < 1 Or X(C) > 50 Then M = "Number(s) between 1 and 50 only !": Beep: Exit For
                S = S + X(C):  W(X(C)) = False
            Next
        End If
    Loop Until M = ""
        [A1].CurrentRegion.Offset(1).Clear
        N = K - UBound(X) - 2:  W = Filter(W, False, False)
        Set oDic = CreateObject("Scripting.Dictionary")
        CountSumCombinate UBound(X) + 2, S
    If oDic.Count Then
        [A2].Resize(oDic.Count, 2).Value2 = Application.Transpose(Array(oDic.Keys, oDic.Items))
        oDic.RemoveAll
    End If
        Set oDic = Nothing
        Erase W
End Sub

 

[motilulla]

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:

Hello joeu2004, thank you for clarifying and for making an improved version. Just updated in my archive

I'll follow up later. Things to do; places to be.

Hello joeu2004, yes sure, please take a look when you can thank you

Kind Regards
Moti

 

[motilulla]

As it's better with the screen updating desactivated so finally :​

Marc L, VBA code is generating all combinations along with the sums, thank you for this added option it is just amazing I like it very much.

I noticed that if I select in the input (1 2) it generate total 17296 combinations 1st set with = 1+2+3+4+5 = 15 and 2nd set with 1+2+48+49+50 = 150, so far with min sum 15 and max sum 150 that is perfect!

Now if I select in the input (2 3) it must generate less combinations and 1st set with = 2+3+4+5+6 = 20 and 2nd set with 2+3+48+49+50 = 152

Now if I select in the input (45 46) it must generate much more less combinations and 1st set with = 45+46+47+48+49 = 235 and 2nd set with 45+46+48+49+50 = 238

I observe it is generating always 17296.

Please could you check?

Kind Regards
Moti

 

[motilulla]

To count only the number of combinations by sum a new VBA procedure as last demonstration to paste to the top of the worksheet module :​

Marc L, if I select in the input (1 2) it gives perfect number of combinations by sum, but selecting different inputs like (3 4), (10 12), (45 46)...it does not give correct sums

Please could you check?

Kind Regards
Moti

 

[Marc L]

It's what happens when the post is not well elaborated without any accurate result attachment !​

You have asked in post #9 for « fixing some numbers like "1 and 4", "5 and 6" »​

so from 50 numbers minus 2 as fixed numbers there are obviously 48 numbers left …​

​

Now it seems for 5 & 6 as fixed the smallest number is 7 but numbers from 1 to 4 are missing ?​

And what should be the expected result if the list is fixing numbers 1 & 4 ?​

 

[motilulla]

It's what happens when the post is not well elaborated without any accurate result attachment !​

You have asked in post #9 for « fixing some numbers like "1 and 4", "5 and 6" »​

so from 50 numbers minus 2 as fixed numbers there are obviously 48 numbers left …​

​

Now it seems for 5 & 6 as fixed the smallest number is 7 but numbers from 1 to 4 are missing ?​

And what should be the expected result if the list is fixing numbers 1 & 4 ?​

Marc L, I am agree with your statement 100%, I apologise for the confusion really I tell you after I get the VBA I tried different option and realize my mistake.

Know you have made it clearer. Please could you correct it?

Kind Regards
Moti