VBA generate 5_50 combinations from (5 groups)

[motilulla]

Using Excel 2010
Hello,

I want a VBA that can generate 5_50 lottery combinations out of 5 groups are in range A6:E15 (Generate set of 5 numbers but pick only “1 number” from each of 5 groups)…generate combinations in columns G:K.

For example 1, 2, 3, 4, 5 is not correct because this has 5 numbers from only group, … but can be good 1, 11, 21, 31, 41 one number from each group.

Here below is short example. Is it possible?

Excel Questions.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3
4
5	Gr1	Gr2	Gr3	Gr4	Gr5		n1	n2	n3	n4	n5
6	1	11	21	31	41		1	11	21	31	41
7	2	12	22	32	42		1	11	21	31	42
8	3	13	23	33	43		1	11	21	31	43
9	4	14	24	34	44		1	11	21	31	44
10	5	15	25	35	45		1	11	21	31	45
11	6	16	26	36	46		1	11	21	31	46
12	7	17	27	37	47		1	11	21	31	47
13	8	18	28	38	48		1	11	21	31	48
14	9	19	29	39	49		1	11	21	31	49
15	10	20	30	40	50		1	11	21	31	50
16							1	11	21	32	41
17							1	11	21	32	42
18							1	11	21	32	43
19							1	11	21	32	44
20							1	11	21	32	45
21							1	11	21	32	46
22							1	11	21	32	47
23							1	11	21	32	48
24							1	11	21	32	49
25							1	11	21	32	50
26							1	11	21	33	41
27							1	11	21	33	42
28							1	11	21	33	43
29							1	11	21	33	44
30							1	11	21	33	45
31							1	11	21	33	46
32							1	11	21	33	47
33							1	11	21	33	48
34							1	11	21	33	49
35							1	11	21	33	50
36
37
38
39
40
1 Number By Group

Regards,
Moti

 

[motilulla]

Hello, My friend made me the code below accordingly post#1 requirement which is working well this create 100000 combinations picking 1 number from each group. Please try.

Sub Pick_1Num_FromEachGroup()

Dim a As Long, b As Long, c As Long, d As Long, Num As Long
Dim Gr1, Gr2, Gr3, Gr4, Gr5, Res

Gr1 = Range("A6:A15")
Gr2 = Range("B6:B15")
Gr3 = Range("C6:C15")
Gr4 = Range("D6:D15")
Gr5 = Range("E6:E15")


ReDim Res(1 To 200000, 1 To 10)

For z = 1 To UBound(Gr1)
If Gr1(z, 1) = "" Then Exit For
    For a = 1 To UBound(Gr2)
        For b = 1 To UBound(Gr3)
            For c = 1 To UBound(Gr4)
                For d = 1 To UBound(Gr5)
                    Num = Num + 1
                    Res(Num, 1) = Gr1(z, 1)
                    Res(Num, 2) = Gr2(a, 1)
                    Res(Num, 3) = Gr3(b, 1)
                    Res(Num, 4) = Gr4(c, 1)
                    Res(Num, 5) = Gr5(d, 1)
                Next
            Next
        Next
    Next
Next

Range("G6").Resize(Num, 5) = Res

End Sub

I want bit more twist but which is not possible for him, so please I need expert help I want to pick as follow…

Option1-pick from…Gr1-0num, Gr2-0num, Gr3-0num, Gr4-1num, Gr5-4num this will create 2100 combinations.

Option2-pick from…Gr1-0num, Gr2-0num, Gr3-0num, Gr4-2num, Gr5-3num this will create 5400 combinations.

Please help to make it possible.

Regards,
Moti

 

[motilulla]

Hello, sorry I changed a layout for easier picks from cell values.

Present macro post#2 picks 1 number from each 5 groups and makes 100000 combinations.

I need to pick instead 1 number out of 5 groups (do not pick any number from first three groups) just pick 2 numbers from Gr4, & 3 numbers from Gr 5

Pick from…Gr1-0num, Gr2-0num, Gr3-0num, Gr4-2num, Gr5-3num this will create 5400 combinations.

I want code also pick group number selection from the sheet rang C3:G3 as now 0 0 0 2 3 from each group

Please help to make it possible.

Here is also the cross post link…where is the example file attached too.

Modify VBA to pick numbers from group.

New layout…

Modifiy Macro Pick From Group.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2			Pick	Pick	Pick	Pick	Pick
3		Elements From Group->	0	0	0	2	3
4
5			Gr1	Gr2	Gr3	Gr4	Gr5		n1	n2	n3	n4	n5
6			1	11	21	31	41		31	32	41	42	43
7			2	12	22	32	42		31	32	41	42	44
8			3	13	23	33	43		31	32	41	42	45
9			4	14	24	34	44		31	32	41	42	46
10			5	15	25	35	45		31	32	41	42	47
11			6	16	26	36	46		31	32	41	42	48
12			7	17	27	37	47		31	32	41	42	49
13			8	18	28	38	48		31	32	41	42	50
14			9	19	29	39	49		31	32	41	43	44
15			10	20	30	40	50		31	32	41	43	45
16									31	32	41	43	46
17									31	32	41	43	47
18									31	32	41	43	48
19									31	32	41	43	49
20									31	32	41	43	50
21									31	32	41	44	45
22									31	32	41	44	46
23									31	32	41	44	47
24									31	32	41	44	48
25									31	32	41	44	49
26									31	32	41	44	50
27									31	32	41	45	46
28									31	32	41	45	47
29									31	32	41	45	48
30									31	32	41	45	49
31									31	32	41	45	50
32									31	32	41	46	47
33									31	32	41	46	48
34									31	32	41	46	49
35									31	32	41	46	50
36									31	32	41	47	48
37									31	32	41	47	49
38									31	32	41	47	50
39									31	32	41	48	49
40									31	32	41	48	50
41									31	32	41	49	50
42									31	32	42	43	44
43									31	32	42	43	45
44									31	32	42	43	46
45									31	32	42	43	47
46									31	32	42	43	48
47									31	32	42	43	49
48									31	32	42	43	50
49									31	32	42	44	45
50									31	32	42	44	46
51									31	32	42	44	47
52									31	32	42	44	48
53									31	32	42	44	49
54									31	32	42	44	50
55									31	32	42	45	46
56									31	32	42	45	47
57									31	32	42	45	48
58									31	32	42	45	49
59									31	32	42	45	50
60									31	32	42	46	47
61									31	32	42	46	48
62									31	32	42	46	49
63									31	32	42	46	50
64									31	32	42	47	48
65									31	32	42	47	49
66									31	32	42	47	50
67									31	32	42	48	49
68									31	32	42	48	50
69									31	32	42	49	50
70									31	32	43	44	45
71									31	32	43	44	46
72									31	32	43	44	47
73									31	32	43	44	48
74									31	32	43	44	49
75									31	32	43	44	50
76									31	32	43	45	46
77									31	32	43	45	47
78									31	32	43	45	48
79									31	32	43	45	49
80									31	32	43	45	50
81									31	32	43	46	47
82									31	32	43	46	48
83									31	32	43	46	49
84									31	32	43	46	50
85									31	32	43	47	48
86									31	32	43	47	49
87									31	32	43	47	50
88									31	32	43	48	49
89									31	32	43	48	50
90									31	32	43	49	50
Euromillone

Regards,
Moti

 

[motilulla]

BUMP

 

[motilulla]

Hello, sorry I changed a layout for easier picks from cell values.

Present macro post#2 picks 1 number from each 5 groups and makes 100000 combinations.

I need to pick instead 1 number out of 5 groups (do not pick any number from first three groups) just pick 2 numbers from Gr4, & 3 numbers from Gr 5

Pick from…Gr1-0num, Gr2-0num, Gr3-0num, Gr4-2num, Gr5-3num this will create 5400 combinations.

I want code also pick group number selection from the sheet rang C3:G3 as now 0 0 0 2 3 from each group

Please help to make it possible.

Here is also the cross post link…where is the example file attached too.

Modify VBA to pick numbers from group.

New layout…

Modifiy Macro Pick From Group.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1
2			Pick	Pick	Pick	Pick	Pick
3		Elements From Group->	0	0	0	2	3
4
5			Gr1	Gr2	Gr3	Gr4	Gr5		n1	n2	n3	n4	n5
6			1	11	21	31	41		31	32	41	42	43
7			2	12	22	32	42		31	32	41	42	44
8			3	13	23	33	43		31	32	41	42	45
9			4	14	24	34	44		31	32	41	42	46
10			5	15	25	35	45		31	32	41	42	47
11			6	16	26	36	46		31	32	41	42	48
12			7	17	27	37	47		31	32	41	42	49
13			8	18	28	38	48		31	32	41	42	50
14			9	19	29	39	49		31	32	41	43	44
15			10	20	30	40	50		31	32	41	43	45
16									31	32	41	43	46
17									31	32	41	43	47
18									31	32	41	43	48
19									31	32	41	43	49
20									31	32	41	43	50
21									31	32	41	44	45
22									31	32	41	44	46
23									31	32	41	44	47
24									31	32	41	44	48
25									31	32	41	44	49
26									31	32	41	44	50
27									31	32	41	45	46
28									31	32	41	45	47
29									31	32	41	45	48
30									31	32	41	45	49
31									31	32	41	45	50
32									31	32	41	46	47
33									31	32	41	46	48
34									31	32	41	46	49
35									31	32	41	46	50
36									31	32	41	47	48
37									31	32	41	47	49
38									31	32	41	47	50
39									31	32	41	48	49
40									31	32	41	48	50
41									31	32	41	49	50
42									31	32	42	43	44
43									31	32	42	43	45
44									31	32	42	43	46
45									31	32	42	43	47
46									31	32	42	43	48
47									31	32	42	43	49
48									31	32	42	43	50
49									31	32	42	44	45
50									31	32	42	44	46
51									31	32	42	44	47
52									31	32	42	44	48
53									31	32	42	44	49
54									31	32	42	44	50
55									31	32	42	45	46
56									31	32	42	45	47
57									31	32	42	45	48
58									31	32	42	45	49
59									31	32	42	45	50
60									31	32	42	46	47
61									31	32	42	46	48
62									31	32	42	46	49
63									31	32	42	46	50
64									31	32	42	47	48
65									31	32	42	47	49
66									31	32	42	47	50
67									31	32	42	48	49
68									31	32	42	48	50
69									31	32	42	49	50
70									31	32	43	44	45
71									31	32	43	44	46
72									31	32	43	44	47
73									31	32	43	44	48
74									31	32	43	44	49
75									31	32	43	44	50
76									31	32	43	45	46
77									31	32	43	45	47
78									31	32	43	45	48
79									31	32	43	45	49
80									31	32	43	45	50
81									31	32	43	46	47
82									31	32	43	46	48
83									31	32	43	46	49
84									31	32	43	46	50
85									31	32	43	47	48
86									31	32	43	47	49
87									31	32	43	47	50
88									31	32	43	48	49
89									31	32	43	48	50
90									31	32	43	49	50
Euromillone

Regards,
Moti

Hello, I want to share solution from cross post link below may it help someone here.

Modify VBA to pick numbers from group. [SOLVED]

Here is a macro which will work perfect with post#3 as it is presented and the combination values can be changed from the range C3:G3.

Good Luck to everyone.

Kind Regards,
Moti

Option Explicit

Sub test() 'By jindon
    Dim i As Long, ii As Long, iii As Long, iv As Long, n As Long
    Dim s(3) As String, x(1 To 100), temp
    Dim cn As Object, rs As Object
    With [c5].CurrentRegion
        .Cells(1, .Columns.Count + 2).CurrentRegion.Offset(1).ClearContents
        For i = 1 To .Columns.Count
            If .Cells(-1, i) > 0 Then
                If .Cells(-1, i) > 1 Then ReDim temp(1 To .Cells(-1, i))
                For ii = 1 To .Cells(-1, i)
                    n = n + 1: x(n) = Join(Array("C", i, ii), "_")
                    [c5].CurrentRegion.Offset(1).Columns(i).Name = x(n)
                    If .Cells(-1, i) > 1 Then temp(ii) = "[" & x(n) & "].F1"
                Next
                If ii > 2 Then
                    For iii = 1 To ii - 2
                        For iv = iii + 1 To ii - 1
                            s(3) = s(3) & IIf(s(3) <> "", " And ", "") & _
                            "(" & temp(iii) & " < " & temp(iv) & ")"
                        Next
                    Next
                End If
            End If
        Next
        If n = 0 Then Exit Sub
        For i = 1 To n
            s(0) = s(0) & IIf(s(0) <> "", ", ", "") & "[" & x(i) & "].F1"
            s(1) = s(1) & IIf(s(1) <> "", ", ", "") & "[" & x(i) & "]"
            s(2) = s(2) & IIf(s(2) <> "", " And ", "") & "[" & x(i) & "].F1 Is Not Null"
        Next
        Set cn = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & _
            ThisWorkbook.FullName & ";Extended Properties='Excel 12.0;HDR=No';"
        rs.Open "Select " & s(0) & " From " & s(1) & " Where " & s(2) & _
            IIf(Len(s(3)), " And ", "") & s(3) & " Order By " & s(0) & ";", cn, 3, 3, 1
        .Cells(2, .Columns.Count + 2).CopyFromRecordset rs
    End With
    For i = 1 To n
        ThisWorkbook.Names(x(i)).Delete
    Next
    Set cn = Nothing: Set rs = Nothing
End Sub