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

HTML Code:

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

To this

HTML Code:

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-q...binations.html

**motilulla** · 06-05-2016, 04:08 AM

Originally Posted by PAB

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

Originally Posted by mdmackillop

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.

**PAB** · 06-05-2016, 08:41 AM

Thanks for the thumbs up mdmackillop

.

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

Originally Posted by PAB

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

**motilulla** · 06-05-2016, 04:00 PM

Originally Posted by mdmackillop

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

Originally Posted by motilulla

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

Originally Posted by PAB

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

Thread: Generate 5/50 lottery combination with selected odd sum or by even sum!!

Thread Tools

Display

Generate 5/50 lottery combination with selected odd sum or by even sum!!

Posting Permissions