HELP!!! VBA Macro

K

Kenya649

Member
I have the following 15 groups of two numbers per group
1,2 2,3 3,4 4,5 5,6
1,3 2,4 3,5 4,6
1,4 2,5 3,6
1,5 2,6
1,6

my problem is to pick three different groups without repeating a number i.e

1,2 & 3,4 & 5,6 or
1,2 & 3,5 & 4,6 or
1,2 & 3,6 & 4,5 or
1,3 & 2,4 & 5,6 or
1,3 & 2,5 & 4,6 or
1,3 & 2,6 & 4,5 or
1,4 & 2,3 & 5,6 or
1,5 & 2,3 & 4,6 or
1,6 & 2,3 & 4,5 or
1,4 & 2,5 & 3,6 or
1,4 & 2,6 & 3,5 or
1,5 & 2,4 & 3,6 or
1,6 & 2,4 & 3,5 or
1,5 & 2,6 & 3,4 or
1,6 & 2,5 & 3,4 and so on (not sure if I have listed all)

I have realized majority of drawn numbers in our local game are from previous three lines or two.

:beer:
Thanks

Kenya649
 
G

GillesD

Member
Program to identify groups for 6 different numbers

If I understand well your post, the macro listed below should satisfy your need.

First, the set-up for the sheet:
- in A1 to C1, enter the labels #, N1 and N2;
- in subsequent lines, enter in column A a sequential number identifying the group of 2 numbers, then in columns B and C, the first and second number of each group
- in D1, enter the total number of groups, either through a formula or manually (like 15 in your example).

Run the macro listed below, and you should get, starting at E2 a sequential number identifying a set of 3 groups with 6 different numbers followed in columns F, G and H, the group numbers you have to use to get the required result. Of course, you could modify the macro to list instead the 6 different numbers.

Listing of the macro:

Option Explicit
Option Base 1

Dim A As Integer, B As Integer, C As Integer, I As Integer
Dim Grp As Integer, N1() As Integer, N2() As Integer

Sub Groups()
Range("A1").Select
Grp = Range("D1").Value
ReDim N1(Grp), N2(Grp)
For I = 1 To Grp
N1(I) = ActiveCell.Offset(I, 1).Value
N2(I) = ActiveCell.Offset(I, 2).Value
Next I
Range("E1").Select
I = 0
For A = 1 To Grp - 2
For B = A + 1 To Grp - 1
For C = B + 1 To Grp
If Not (N1(A) = N1(B) Or N1(A) = N2(B) Or N2(A) = N1(B) Or N2(A) = N2(B) _
Or N1(A) = N1(C) Or N1(A) = N2(C) Or N2(A) = N1(C) Or N2(A) = N2(C) _
Or N1(B) = N1(C) Or N1(B) = N2(C) Or N2(B) = N1(C) Or N2(B) = N2(C)) Then
I = I + 1
ActiveCell.Offset(I, 0).Value = I
ActiveCell.Offset(I, 1).Value = A
ActiveCell.Offset(I, 2).Value = B
ActiveCell.Offset(I, 3).Value = C
End If
Next C
Next B
Next A
End Sub
 
G

GillesD

Member
Complementary information

With 15 groups of 2 numbers (like Kenya649 listed), you can generate 455 combinations, as calculated by the function COMBIN(15,3).

Out of these, only 15 combinations will provide 6 different numbers to play in a 6/49 lottery and the macro will list the groups needed to get this. But if you enter more than 15 groups, this is where the macro gets useful.
 
K

Kenya649

Member
Results

# N1 N2 15
1 1 2
2 1 3
3 1 4
4 1 5
5 1 6
6 2 3
7 2 4
8 2 5
9 2 6
10 3 4
11 3 5
12 3 6
13 4 5
14 4 6
15 5 6


after running the macro you get

1 1 10 15
2 1 11 14
3 1 12 13
4 2 7 15
5 2 8 14
6 2 9 13
7 3 6 15
8 3 8 12
9 3 9 11
10 4 6 14
11 4 7 12
12 4 9 10
13 5 6 13
14 5 7 11
15 5 8 10
and after replacing each number above with the group represented i.e 1 =1,3 or 10=3,4 you get

1,2 3,4 5,6
1,3 3,5 4,6
1,4 3,6 3,6
1,3 2,4 5,6
1,3 2,5 4,6
1,3 2,6 4,5
1,4 2,6 5,6
1,4 2,5 3,6
1,4 2,6 3,5
1,5 2,6 4,6
1,5 2,4 3,6
1,5 2,6 3,4
1,6 2,6 4,5
1,6 2,4 3,5
1,6 2,5 3,4

what is my requirement.

Thanks a lot GillesD :beer:
 
K

Kenya649

Member
GillesD said:
But if you enter more than 15 groups, this is where the macro gets useful.
Click to expand...

this is where the macro gets useful ..... How?

if you do not mind please elaborate more

Thanks
 
G

GillesD

Member
Thinking in groups of two (or pairs)

Kenya649 said:
this is where the macro gets useful ..... How? ..... if you do not mind please elaborate more.
Thanks
Click to expand...
As a matter of fact, the macro is useful if you think of likely numbers in groups of two (any number of them).

An example: let's say you have identified the 15 groups mentioned in you first post as possible winners but you also like numbers 48 and 49 as another possibility (or they are your favorite numbers). Easily said, and easily done, just add a 16th group (48, 49), adjust the value in D1 and run the macro. In no time, you will have the 60 possible combinations with all different numbers (out of the 560 combinations made out of 3 groups from 16 groups).

And if you do not want to make errors replacing each group by its respective numbers, consider modifying the macro as such:

1 - Remove the 4 lines starting with Activecell.Offset ... in the FOR ... NEXT loops

2 - Put instead the following lines:
ActiveCell.Offset(I, 0).Value = I
ActiveCell.Offset(I, 1).Value = N1(A)
ActiveCell.Offset(I, 2).Value = N2(A)
ActiveCell.Offset(I, 3).Value = N1(B)
ActiveCell.Offset(I, 4).Value = N2(B)
ActiveCell.Offset(I, 5).Value = N1(C)
ActiveCell.Offset(I, 6).Value = N2(C)

And you will have all the combinations listed directly in columns E to K (individual numbers being in columns F-K).
 
K

Kenya649

Member
4 Number Guarantee Win from all 49 numbers

With 3989 lines your are guaranteed a one 4/6 win irrespective how you arrange the 49 numbers

My question is how many times can you arrange/permute all the 49 numbers and came up with unique 3989 lines i.e without repeating any singe line.

I have written a macro which has produced 11 lines so far though it is very slow (and still running). The lines are

1--27,32,45,8,47,35,40,44,36,25,41,43,37,10,49,28,7,46,17,5,30,26,4,3,33,39,2,20,23,48,11,9,38,18,14,22,1,42,6,34,12,29,24,19,21,15,31,13,16
2--35,25,33,42,29,11,12,4,18,41,26,47,31,22,34,10,16,14,32,30,8,1,20,39,15,2,46,3,6,23,28,13,36,9,37,49,27,38,24,19,5,45,7,43,17,40,44,48,21
3--8,43,10,28,9,22,27,48,41,38,2,11,39,3,12,1,29,6,20,33,17,15,46,31,32,40,44,26,19,4,8,24,30,21,35,37,13,49,47,45,42,36,14,25,5,7,34,16,23
4--49,31,36,13,18,28,26,12,42,38,6,21,20,7,32,23,15,24,39,33,43,30,47,1,4,35,37,2,40,27,44,14,29,10,46,3,45,8,22,48,11,19,41,5,9,25,17,16,34
5--30,32,13,33,34,8,44,19,35,16,17,5,2,20,7,23,48,29,43,26,46,15,28,1,21,36,25,11,14,22,41,9,10,49,38,47,18,40,45,4,6,3,31,24,37,27,39,12,42
6--36,26,18,11,13,7,25,4,27,43,45,46,3,15,19,8,1,39,42,5,14,34,32,9,49,29,40,44,16,38,23,33,10,24,21,6,31,35,37,20,17,28,22,47,30,12,2,48,41
7--18,21,46,1,34,44,11,47,13,23,41,43,5,27,6,48,16,39,25,15,3,19,22,30,42,32,36,28,37,4,7,49,12,45,20,38,31,24,17,10,8,35,26,33,9,40,14,29,2
8--27,48,1,40,10,14,36,26,49,41,16,33,43,20,42,2,18,31,24,11,32,3,23,44,17,13,22,34,9,25,46,5,4,21,19,8,7,35,28,12,29,6,45,39,15,47,30,37,38
9--5,45,41,37,36,32,20,23,13,38,26,7,14,49,47,46,25,4,18,16,2,17,48,9,15,42,40,34,33,30,21,12,19,29,27,44,22,35,3,10,39,8,6,43,24,1,28,31,11
10--45,23,4,26,5,12,34,36,2,24,41,19,28,11,38,10,42,46,39,27,33,35,17,16,1,9,21,20,8,37,6,25,29,7,22,3,47,32,40,43,15,49,44,13,30,48,31,18,14
11--11,32,14,24,45,44,8,47,27,9,16,6,18,19,29,48,15,22,13,46,2,43,42,20,12,21,10,4,41,5,7,17,33,1,34,49,36,31,28,35,3,38,25,37,39,26,23,40,30

Please assist to come up with more numbers

This will assist me in winning 4/6 with a fewer lines

Thanks
 
You must log in or register to reply here.

Sidebar

Top