PDA

View Full Version : [SOLVED] Generate 5/50 lottery combination with selected odd sum or by even sum!!



motilulla
06-04-2016, 08:24 AM
Hello,

"Loop through combinations and add only Even & Odd numbers together within each."

I come across above thread and find VBA code under the post#2 which list "Even Sum-Total Combinations" "Odd Sum-Total Combinations" for lottery 6/59

I changed

Const Drawn As Long = 6
Const MaxF As Long = 59

To this

Const Drawn As Long = 5
Const MaxF As Long = 50

It generate the list of "Even Sum-Total Combinations" "Odd Sum-Total Combinations" for lottery 5/50

My question is it possible to generate the combination instead of listing it.
for example with even sum 0 = 53130.
And for example with odd sum 4 = 2300 etc… as require.

Thanks In Advance

Using Excel 2000

Regards,
Moti

PAB
06-05-2016, 03:53 AM
Hi motilulla, welcome to the board.

Did you not get an answer to this here...

http://www.mrexcel.com/forum/excel-questions/945240-generate-5-50-lotteries-selected-odd-even-pattern-combinations.html

motilulla
06-05-2016, 04:08 AM
Hi motilulla, welcome to the board.

Did you not get an answer to this here...
Hello PAB, no that is a different question yes which I get the answer B_P code generate odd or even combinations.

Here is my query I want odd sum or even sum combination please see the example below may help

Say I want to VBA produces only that combination which EVEN SUM is for example = 82 than VBA generate following combinations….



n1
n2
n3
n4
n5
Even Sum


1
9
10
22
50
82


2
3
13
38
42
82


2
4
14
26
36
82


3
10
22
37
50
82


3
27
31
38
44
82


4
16
18
25
44
82


7
12
21
26
44
82


9
22
24
27
36
82


10
32
40
41
49
82


11
13
25
32
50
82


11
16
21
22
44
82


14
15
28
35
40
82


23
40
42
43
49
82



Say I want to VBA produces only that combination which ODD SUM is for example = 50 than VBA generate following combinations….



n1
n2
n3
n4
n5
Odd Sum


2
7
24
43
46
50


3
14
26
47
50
50


5
32
44
45
50
50


7
20
38
40
43
50


7
30
38
40
43
50


8
12
19
31
50
50


10
17
18
33
40
50


13
14
32
37
48
50


13
16
37
44
50
50


14
15
28
35
40
50


14
16
19
20
31
50


14
23
27
30
36
50


15
35
38
44
48
50




Thank you

Regards,
Moti

PAB
06-05-2016, 06:12 AM
Hi moti,

I have put this together for you, give it a go...


Option Explicit
Option Base 1

Const MinA As Integer = 1
Const MaxF As Integer = 50

Sub Sum_Total()
Dim SumTot As Integer
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Cells.Delete: Cells(1, 1).Select

SumTot = CInt(InputBox("Please enter the desired sum total.", "Combinations Sum Total.", 0))
If SumTot = 0 Then Exit Sub

For A = MinA To MaxF - 4
For B = A + 1 To MaxF - 3
For C = B + 1 To MaxF - 2
For D = C + 1 To MaxF - 1
For E = D + 1 To MaxF
If SumTot = A + B + C + D + E Then
ActiveCell.Value = _
Format(A, "00") & "-" _
& Format(B, "00") & "-" _
& Format(C, "00") & "-" _
& Format(D, "00") & "-" _
& Format(E, "00")
ActiveCell.Offset(1, 0).Select
End If
Next E
Next D
Next C
Next B
Next A

Cells.EntireColumn.AutoFit: Cells(1, 1).Select
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub


I hope this helps!

mdmackillop
06-05-2016, 06:46 AM
Hi PAB
I believe he wants only the odd or even numbers in each combination to equate to the desired total. See post #3
Regards
MD

PAB
06-05-2016, 07:01 AM
Hi PAB
I believe he wants only the odd or even numbers in each combination to equate to the desired total. See post #3
Thanks mdmackillop, I missed that.
I will have to do further investigation on how to achieve that.

mdmackillop
06-05-2016, 08:02 AM
Building on your code

For E = D + 1 To MaxF
k = 0
arr1 = Array(A, B, C, D, E)
arr2 = Array(A Mod 2 = 0, B Mod 2 = 0, C Mod 2 = 0, D Mod 2 = 0, E Mod 2 = 0)
For i = 1 To 5
k = k + (arr1(i) * -arr2(i))
Next i
If SumTot = k Then
ActiveCell.Value = _

PAB
06-05-2016, 08:41 AM
Thanks for the thumbs up mdmackillop :thumb.

Give this a go moti...


Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 50
Sub Sum_Total_New_1()
Dim SumTot As Integer
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer
Dim i As Integer, k As Integer
Dim arr1() As Variant, arr2() As Variant
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Cells.Delete: Cells(1, 1).Select
SumTot = CInt(InputBox("Please enter the desired sum total.", "Combinations.", 0))
If SumTot = 0 Then Exit Sub
For A = MinA To MaxF - 4
For B = A + 1 To MaxF - 3
For C = B + 1 To MaxF - 2
For D = C + 1 To MaxF - 1
For E = D + 1 To MaxF
k = 0
arr1 = Array(A, B, C, D, E)
arr2 = Array(A Mod 2 = 0, B Mod 2 = 0, C Mod 2 = 0, D Mod 2 = 0, E Mod 2 = 0)
For i = 1 To 5
k = k + (arr1(i) * -arr2(i))
Next i
If SumTot = k Then
ActiveCell.Value = _
Format(A, "00") & "-" _
& Format(B, "00") & "-" _
& Format(C, "00") & "-" _
& Format(D, "00") & "-" _
& Format(E, "00")
ActiveCell.Offset(1, 0).Select
End If
Next E
Next D
Next C
Next B
Next A
Cells.EntireColumn.AutoFit: Cells(1, 1).Select
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub


I hope this helps!

PAB
06-05-2016, 09:14 AM
This one should cater for both Odd & Even sum totals...


Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 50
Sub Sum_Total_New_2()
Dim SumTot As Integer
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer
Dim i As Integer, j As Integer, k As Integer, l As Integer
Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Cells.Delete: Cells(1, 1).Select
SumTot = CInt(InputBox("Please enter the desired sum total.", "Combinations.", 0))
If SumTot = 0 Then Exit Sub
For A = MinA To MaxF - 4
For B = A + 1 To MaxF - 3
For C = B + 1 To MaxF - 2
For D = C + 1 To MaxF - 1
For E = D + 1 To MaxF
j = 0: l = 0
arr1 = Array(A, B, C, D, E)
arr2 = Array(A Mod 2 = 0, B Mod 2 = 0, C Mod 2 = 0, D Mod 2 = 0, E Mod 2 = 0)
For i = 1 To 5
j = j + (arr1(i) * -arr2(i))
Next i
If SumTot = j Then
ActiveCell.Value = _
Format(A, "00") & "-" _
& Format(B, "00") & "-" _
& Format(C, "00") & "-" _
& Format(D, "00") & "-" _
& Format(E, "00")
ActiveCell.Offset(1, 0).Select
End If
arr3 = Array(A Mod 2 = 1, B Mod 2 = 1, C Mod 2 = 1, D Mod 2 = 1, E Mod 2 = 1)
For k = 1 To 5
l = l + (arr1(k) * -arr3(k))
Next k
If SumTot = l Then
ActiveCell.Value = _
Format(A, "00") & "-" _
& Format(B, "00") & "-" _
& Format(C, "00") & "-" _
& Format(D, "00") & "-" _
& Format(E, "00")
ActiveCell.Offset(1, 0).Select
End If
Next E
Next D
Next C
Next B
Next A
Cells.EntireColumn.AutoFit: Cells(1, 1).Select
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With


I hope this helps!

PAB
06-05-2016, 11:21 AM
Hi moti,

Here is the revised code that has been produced with the very kind help and input by MD, very much appreciated MD.
It produces the total sum for Even & Odd in adjacent columns according to the sum total you enter in the Input Box.


Option Explicit
Option Base 1
Const MinA As Long = 1
Const MaxF As Long = 50
Sub Sum_Total_New_5()
Dim SumTot As Long
Dim A As Long, B As Long, C As Long, D As Long, E As Long
Dim i As Long, j As Long, m As Long
Dim arr1() As Variant, arr2() As Variant
Dim r As Range

With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
Cells.Delete: Cells(1, 1).Select
Set r = Cells(1, 1)
r.Resize(, 2) = Array("Even", "Odd")
SumTot = CInt(InputBox("Please enter the desired sum total.", "Combinations.", 0))
If SumTot = 0 Then Exit Sub
For A = MinA To MaxF - 4
For B = A + 1 To MaxF - 3
For C = B + 1 To MaxF - 2
For D = C + 1 To MaxF - 1
For E = D + 1 To MaxF
arr1 = Array(A, B, C, D, E)
For m = 0 To 1
arr2 = Array(A Mod 2 = m, B Mod 2 = m, C Mod 2 = m, D Mod 2 = m, E Mod 2 = m)
j = 0
For i = 1 To 5
j = j + (arr1(i) * -arr2(i))
Next i
If SumTot = j Then
Cells(Rows.Count, 1 + m).End(xlUp)(2).Value _
= Format(A, "00") & "-" _
& Format(B, "00") & "-" _
& Format(C, "00") & "-" _
& Format(D, "00") & "-" _
& Format(E, "00")
End If
Next m
Next E
Next D
Next C
Next B
Next A
Cells.EntireColumn.AutoFit: Cells(1, 1).Select
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub


I hope this answers your request.

motilulla
06-05-2016, 02:48 PM
Hi moti,

Here is the revised code that has been produced with the very kind help and input by MD, very much appreciated MD.
It produces the total sum for Even & Odd in adjacent columns according to the sum total you enter in the Input Box.

I hope this answers your request.
PAB, I am sorry for replying you late I was away from my desk computer.

Wow!! Speechless PAB, your code is working flawless it is resulting as request.

Please could you check it must generate 53.130 combinations with zero "0" Even & Odd sum.Like with 0 even for example 7-23-29-37-41 and with 0 odd for example 6-12-26-30-48

Also thank you for code #post4 which generate row total sum I will keep for my archive it is perfect too.

I appreciate a lot your kind help

Regards,
Moti :)

mdmackillop
06-05-2016, 03:33 PM
Hi Moti
Surely you can check the code provided for you. If it does not provide the answer, a quick inspection should show what you need to change.
Regards
MD

motilulla
06-05-2016, 04:00 PM
Hi Moti
Surely you can check the code provided for you. If it does not provide the answer, a quick inspection should show what you need to change.
Regards
MD
Hello MD

Thank you for your interest. I checked the code thoroughly and find it do not generate the combinations either with even sum 0 or neither with odd sum 0 I mean if I input 0 it must generate 53.130 combinations with each even & odd sum please see the table below for all possible combinations can be produced by even & odd sum



Even Sum
Total Combinations
Odd Sum
Total Combinations


0
53130
0
53130


2
12650
1
12650


4
12650
3
12650


6
14950
4
2300


8
14950
5
12650


10
17250
6
2300


12
17550
7
12650


14
19850
8
4600


16
20150
9
12950


18
22750
10
4600


20
23075
11
12950


22
25675
12
6900


24
26300
13
13250


26
28925
14
6900


28
29575
15
13550


30
32501
16
9225


32
33176
17
13850


34
36127
18
9225


36
37128
19
14150


38
40105
20
11550


40
41132
21
14750


42
44435
22
11575


44
45513
23
15050


46
48843
24
13925


48
50248
25
15651


50
53630
26
13950


52
42437
27
16251


54
43847
28
16325


56
43057
29
16852


58
44220
30
16375


60
43484
31
17453


62
44401
32
18775


64
43394
33
18355


66
44341
34
18850


68
43089
35
18957


70
43742
36
21275


72
42495
37
19860


74
42878
38
21375


76
41337
39
20763


78
41701
40
23850


80
39865
41
21668


82
39909
42
23975


84
38053
43
22573


86
37777
44
26475


88
35575
45
23780


90
35253
46
26650


92
32729
47
24687


94
32035
48
29200


96
29438
49
25897


98
28395
50
29400


100
25424
51
14457


102
24281
52
29700


104
23233
53
15670


106
21988
54
27650


108
21137
55
16584


110
19813
56
28000


112
18856
57
17801


114
17750
58
26000


116
16736
59
18419


118
15547
60
26375


120
14749
61
19341


122
13525
62
24400


124
12667
63
19964


126
11683
64
24825


128
10789
65
20592


130
9769
66
22850


132
9139
67
20920


134
8108
68
23275


136
7442
69
21553


138
6700
70
21325


140
6049
71
21587


142
5297
72
21750


144
4936
73
21926


146
4225
74
19775


148
3881
75
21965


150
3488
76
20200


152
3187
77
22009


154
2838
78
18200


156
2583
79
21753


158
2281
80
18600


160
2049
81
21802


162
1795
82
16575


164
1613
83
21250


166
1385
84
16925


168
1229
85
21003


170
1053
86
14850


172
925
87
20454


174
777
88
15175


176
678
89
19910


178
559
90
13025


180
490
91
19063


182
401
92
13275


184
337
93
18520


186
278
94
11075


188
245
95
17374


190
192
96
11250


192
164
97
16531


194
141
98
8950


196
119
99
15383


198
101
100
9050


200
84
101
14238


202
70
102
8950


204
57
103
13087


206
47
104
8950


208
37
105
12238


210
30
106
8775


212
23
107
11081


214
18
108
8675


216
13
109
10225


218
10
110
8425


220
7
111
9361


222
5
112
8275


224
3
113
8497


226
2
114
7950


228
1
115
7624


230
1
116
7725



2118760
117
7050




118
7375




119
6167




120
7100




121
5583




122
6700




123
4989




124
6400




125
4394




126
5975




127
3789




128
5650




129
3483




130
5225




131
2867




132
4875




133
2550




134
4450




135
2224




136
4125




137
1897




138
3700




139
1561




140
3375




141
1525




142
3000




143
1181




144
2700




145
1138




146
2350




147
1087




148
2100




149
1038




150
1800




151
983




152
1600




153
931




154
1350




155
874




156
1175




157
820




158
975




159
763




160
850




161
710




162
675




163
654




164
575




165
603




166
450




167
550




168
375




169
502




170
275




171
453




172
225




173
409




174
150




175
365




176
125




177
326




178
75




179
287




180
50




181
253




182
25




183
220




184
25




185
192




187
164




189
141




191
119




193
101




195
84




197
70




199
57




201
47




203
37




205
30




207
23




209
18




211
13




213
10




215
7




217
5




219
3




221
2




223
1




225
1





2118760



And one more question code generates combination in single column (it is not hard for me to convert text en columns) but is it too difficult to make it by code directly I mean combinations generate in 5 columns A to E?

Thank you

Regards,
Moti

PAB
06-06-2016, 02:10 AM
I checked the code thoroughly and find it do not generate the combinations either with even sum 0 or neither with odd sum 0.
Hi Moti,

For the first part, to produce the combinations with Odd Sum 0 & Even Sum 0 comment out the line...


If SumTot = 0 Then Exit Sub

I hope this helps!

motilulla
06-06-2016, 02:26 AM
Hi Moti,

For the first part, to produce the combinations with Odd Sum 0 & Even Sum 0 comment out the line...


If SumTot = 0 Then Exit Sub

I hope this helps!
Wow!! Thank You PAB, this did the trick working like magic 100% OK.

I appreciate your kind help and time you spend to solving this as request I can say this is SOLVED

Regards,
Moti :)