Question for GillesD

P

PAB

Member
Hi GillesD,

I Wonder if you would have a Quick Look at this for me Please, it is an Adaption of some VB Code that you Wrote some Time Ago.
I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In the Sheet Named No Bonus, I have Titles in Cells A1:G1, Column A has the Draw Number, and Columns B:G have the 6 Drawn Numbers ( Excluding the Bonus Number ).
In the Sheet Named Bonus, I have Titles in Cells A1:H1, Column A has the Draw Number, and Columns B:H have the 7 ( Including Bonus Number ) Drawn Numbers in Ascending Order.
The Results go into the Sheet Named Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers ( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) = 1,906,884 Combinations ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives an Error 7 Out of Memory.
I think it Might have Something to do with an Overflow on the nBonus & nNoBonus Arrays. Have you Done this Exercise Before, and if so, how did you get Around the Memory for the Array Problem.
Any Suggestions will be Appreciated.
Thanks in Advance.

Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
PAB
:wavey:
 
Last edited:
G

GillesD

Member
VBA coding

I tried to run your code and I got the same message even if I had no data in both sheets.

For me, the error come from the two lines:
- Dim nBonus(49, 49, 49, 49, 49) As Integer
- Dim nNoBonus(49, 49, 49, 49, 49) As Integer

You try to generate huge, huge arrays (282,475,249 possibilities in each case) and the computer does not have enough memory to perform this operation. I tried replacing the number 49 by 10 on both lines and I no longer get the Out of memory error.

But then the macro will not work as intended, since you need to get some variables up from 1 to 49.
 
P

PAB

Member
Thanks for the Reply GillesD.
Have you Any Suggestions on a Different Approach for this?.
I Agree that the Out of Memory Error 7 is Caused by the Two Lines :-
- Dim nBonus(49, 49, 49, 49, 49) As Integer
- Dim nNoBonus(49, 49, 49, 49, 49) As Integer
Have you Done this Exercise Before Using a Different Method that was Successful?.

Thanks in Advance.
All the Best.
PAB
:wavey:
 
bloubul

bloubul

Member
Hi PAB / GillesD

Any progress on this macro, I'm very interested in it.

Also got the memory problem.

Thanks for all your work so far, some of us do "Appreciate" it.

Thanks

BlouBul :cool:
 
P

PAB

Member
Hi GillesD,

I have Tried Various Different Ways to get Around the Out of Memory Error 7 Problem But to No Avail, the Latest Being to Try and Incorporate UBound.
Have you had Any Thoughts on this at All Or Done this Exercise in the Past Using a Different Method that was Successful?.

Thanks in Advance.
All the Best.
PAB
:wavey:
 
G

GillesD

Member
Memory problem

PAB

I have not given too much thought to your problem but here are some ideas. The only time I had a memory problem was when I tried to find all pentas (5 numbers in combinations from 1-2-3-4-5 to 45-46-47-48-49).

I estimated the numbers and tried an array 15,000 by 5 and it worked but soon I will have to increase it.

A two-dimension array (combination-as-text, frequency) could also have worked but these solution requires some rethinking as far as coding is concerned.

Another possibility would be to place data in a sheet. It would slow the program but could store more data that way (I think).

If I have other ideas, I will let you know.
 
G

GillesD

Member
New idea for PAB

I recently ran an application and some of my code may help you with the problem you encountered in your macro.

I had to run through random combinations of 6 numbers and keep a reminder as each combination occured. My solution:

A - Declare variables with the statement
Dim nNum(13983816) As Integer, A(6) As Integer, nLex As Long
- where nNum is an one dimension array for occurences of all combinations;
- where A(6) is an array for the 6 different numbers in increasing order;
- where nLex is the lexographic number for the 6 values in A(6)

B - Generate 6 different numbers
- Find 6 different numbers between 1 and 49 and place them in increasing order in A(1) to A(6)

C - Lexographic value
- Find the lexographic value for numbers in A(1) to A(6) with the statements:
nLex = Application.WorksheetFunction.Combin(49, 6)
If 44 - A(1) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(1), 6)
If 45 - A(2) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(2), 5)
If 46 - A(3) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(3), 4)
If 47 - A(4) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(4), 3)
If 48 - A(5) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(5), 2)
If 49 - A(6) > 0 Then nLex = nLex - Application.WorksheetFunction.Combin(49 - A(6), 1)

D - Occurence of 6 number
- Calculate the occurences of each 6-number combination with the statement:
nNum(nLex) = nNum(nLex) + 1

I am not sure if this will solve your problem but it is just an idea and who knows...
 
P

PAB

Member
Hi GillesD,

Thanks for the Reply.
I will have a Look at your Code and see if I can Incorporate it into the Program for Quintuples.

Thanks Again.
All the Best.
PAB
:wavey:
 
P

PAB

Member
Hi GillesD,

I have Tried Incorporating the Theory of the Code you Kindly Provided into the Program But Unfortunately to No Avail.
Maybe a Better Approach would be to Count the Combinations ( Quintuples ) that have Appeared Rather than Trying to Store the Full 1,906,884.
It would be Nice to be Able to Achieve this But I think it is Beyond my Capabilities at Present.
Thanks for your Contributions, it is Appreciated.

All the Best.
PAB
:wavey:
 
G

GillesD

Member
Counting quintuples

PAB

In a spreadsheet where I look for all possible quintuples that have come out, this is the approach I use.

There are 1,906,884 possible quintuples in a 6-number lottery but even at that an array like nPent(1906884,5) might create memory problem. To get away from that, I estimated how many quintuples may have occurred (actually 13,380 after 2239 draws).

So I set up an array nPent(15000,5) and going through all combinations drawn, I place each number (N1 to N5) in succession in the array. I dump all quintuples on a sheet and sort them in order (actually from 1-2-3-4-13 to 43-44-45-46-47). Going through all of them, I check for duplicate or triplicate quintuples and add the number of occurences in the sixth column while deleting duplicate entries.

This mignt not be the most efficient code but it works and it is not too slow. But after this dicussion, I am now thinking that I could use an array nPent(1906884,2) where I would place the lexographic number of a quintuple and the number of occurences.
 
S

Sammy

Member
Hi PAB,

The concept of your Macro is great. I would love to run a version of this for a 5/34 Lotto to provide 4/5 winning numbers and 4/5 winning numbers plus one bonus number. If you have the time, would you mind providing such an amended version? Very much appreciated.

Cheers
Sammy

PAB said:
Hi GillesD,

I Wonder if you would have a Quick Look at this for me Please, it is an Adaption of some VB Code that you Wrote some Time Ago.
I have Two Sheets, One Named No Bonus & the Other Named Bonus.
In the Sheet Named No Bonus, I have Titles in Cells A1:G1, Column A has the Draw Number, and Columns B:G have the 6 Drawn Numbers ( Excluding the Bonus Number ).
In the Sheet Named Bonus, I have Titles in Cells A1:H1, Column A has the Draw Number, and Columns B:H have the 7 ( Including Bonus Number ) Drawn Numbers in Ascending Order.
The Results go into the Sheet Named Results.
I am Trying to List the Number of Times ALL Combinations of 5 Numbers ( Including & Excluding the Bonus Number ) from 49 ( Combin(49,5) = 1,906,884 Combinations ) have Occurred in the Lotto Draws to Date.
The Code Below for Some Reason gives an Error 7 Out of Memory.
I think it Might have Something to do with an Overflow on the nBonus & nNoBonus Arrays. Have you Done this Exercise Before, and if so, how did you get Around the Memory for the Array Problem.
Any Suggestions will be Appreciated.
Thanks in Advance.

Here is the Code :-

Option Explicit
Option Base 1

Sub List()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nCount As Long
Dim nDraw As Integer
Dim nNo(7) As Integer
Dim nBonus(49, 49, 49, 49, 49) As Integer
Dim nNoBonus(49, 49, 49, 49, 49) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 49

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 7
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(2), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(1), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(6)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(3), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(2), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) = _
nNoBonus(nNo(3), nNo(4), nNo(5), nNo(6), nNo(7)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 4
For j = i + 1 To nMaxF - 3
For k = j + 1 To nMaxF - 2
For l = k + 1 To nMaxF - 1
For m = l + 1 To nMaxF
nCount = nCount + 1
If nCount = 65501 Then
nCount = 1
ActiveCell.Offset(-65500, 8).Select
End If
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = m
ActiveCell.Offset(0, 5).Value = nNoBonus(i, j, k, l, m)
ActiveCell.Offset(0, 6).Value = nBonus(i, j, k, l, m)
ActiveCell.Offset(1, 0).Select
Next m
Next l
Next k
Next j
Next i
Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

All the Best.
PAB
:wavey:
Click to expand...
 
P

PAB

Member
Hi Sammy,


Sammy said:
Hi PAB,

I would love to Run a Version of this for a 5/34 Lotto to Provide 4/5 Winning Numbers and 4/5 Winning Numbers Plus One Bonus Number.
Click to expand...
If I Understand you Correctly, this Should do what you want.
The Macro Below Lists the Total Number of Times EACH Quadruple ( Excluding AND Including the Bonus Number ) has Been Drawn in a 534 + 1 Bonus Number Lotto. The Macro will List EACH Quadruples Combination and the Total Number of Times it has Been Drawn EXCLUDING & INCLUDING the Bonus Number in the Sheet Named "Results" ( this Needs to be Setup ). You can then Use Excel to Analyze the Results.
You Also Need to Setup Two Sheets, One Called "No Bonus" and the Other Called "Bonus".
In the Sheets Named "No Bonus" ( Excluding the Bonus Number ) and "Bonus" ( Including the Bonus Number ), Insert ALL the Results of the Lotto in ASCENDING Order. The First Row MUST Contain Titles for Each Column. Starting in the Second Row, Insert the Draw Numbers in Column A, and the Numbers Drawn in Columns B:G ( Column G Being the Bonus Number ONLY in the Sheet Named "No Bonus" ). You MUST Also have an EMPTY Sheet Named "Results" for the Results to be Output to. After the Macro has Run, you will have EACH Quadruples Combination in Columns A to D. In Column E you will have the Total Number of Times that Quadruple has been Drawn EXCLUDING the Bonus Number, and in Column F you will have the Total Number of Times that Quadruple has been Drawn INCLUDING the Bonus Number.

Option Explicit
Option Base 1

Sub List_Quadruples()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nDraw As Integer
Dim nNo(6) As Integer
Dim nBonus(34, 34, 34, 34) As Integer
Dim nNoBonus(34, 34, 34, 34) As Integer

Application.ScreenUpdating = False

nMinA = 1
nMaxF = 34

Sheets("No Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > 0
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 6
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(4)) + 1
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(3), nNo(5)) + 1
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(2), nNo(4), nNo(5)) + 1
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(1), nNo(3), nNo(4), nNo(5)) + 1
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5)) = _
nNoBonus(nNo(2), nNo(3), nNo(4), nNo(5)) + 1
Next i

Sheets("Bonus").Select
Range("A2").Select

Do While ActiveCell.Value > " "
nDraw = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

Range("A1").Select

For i = 1 To nDraw
For j = 1 To 6
nNo(j) = ActiveCell.Offset(i, j).Value
Next j
nBonus(nNo(1), nNo(2), nNo(3), nNo(4)) = _
nBonus(nNo(1), nNo(2), nNo(3), nNo(4)) + 1
nBonus(nNo(1), nNo(2), nNo(3), nNo(5)) = _
nBonus(nNo(1), nNo(2), nNo(3), nNo(5)) + 1
nBonus(nNo(1), nNo(2), nNo(3), nNo(6)) = _
nBonus(nNo(1), nNo(2), nNo(3), nNo(6)) + 1
nBonus(nNo(1), nNo(2), nNo(4), nNo(5)) = _
nBonus(nNo(1), nNo(2), nNo(4), nNo(5)) + 1
nBonus(nNo(1), nNo(2), nNo(4), nNo(6)) = _
nBonus(nNo(1), nNo(2), nNo(4), nNo(6)) + 1
nBonus(nNo(1), nNo(2), nNo(5), nNo(6)) = _
nBonus(nNo(1), nNo(2), nNo(5), nNo(6)) + 1
nBonus(nNo(1), nNo(3), nNo(4), nNo(5)) = _
nBonus(nNo(1), nNo(3), nNo(4), nNo(5)) + 1
nBonus(nNo(1), nNo(3), nNo(4), nNo(6)) = _
nBonus(nNo(1), nNo(3), nNo(4), nNo(6)) + 1
nBonus(nNo(1), nNo(3), nNo(5), nNo(6)) = _
nBonus(nNo(1), nNo(3), nNo(5), nNo(6)) + 1
nBonus(nNo(1), nNo(4), nNo(5), nNo(6)) = _
nBonus(nNo(1), nNo(4), nNo(5), nNo(6)) + 1
nBonus(nNo(2), nNo(3), nNo(4), nNo(5)) = _
nBonus(nNo(2), nNo(3), nNo(4), nNo(5)) + 1
nBonus(nNo(2), nNo(3), nNo(4), nNo(6)) = _
nBonus(nNo(2), nNo(3), nNo(4), nNo(6)) + 1
nBonus(nNo(2), nNo(3), nNo(5), nNo(6)) = _
nBonus(nNo(2), nNo(3), nNo(5), nNo(6)) + 1
nBonus(nNo(2), nNo(4), nNo(5), nNo(6)) = _
nBonus(nNo(2), nNo(4), nNo(5), nNo(6)) + 1
nBonus(nNo(3), nNo(4), nNo(5), nNo(6)) = _
nBonus(nNo(3), nNo(4), nNo(5), nNo(6)) + 1
Next i

Sheets("Results").Select
Range("A1").Select

For i = 1 To nMaxF - 3
For j = i + 1 To nMaxF - 2
For k = j + 1 To nMaxF - 1
For l = k + 1 To nMaxF
ActiveCell.Offset(0, 0).Value = i
ActiveCell.Offset(0, 1).Value = j
ActiveCell.Offset(0, 2).Value = k
ActiveCell.Offset(0, 3).Value = l
ActiveCell.Offset(0, 4).Value = nNoBonus(i, j, k, l)
ActiveCell.Offset(0, 5).Value = nBonus(i, j, k, l)
ActiveCell.Offset(1, 0).Select
Next l
Next k
Next j
Next i

Columns("A:IV").AutoFit
Columns("A:IV").HorizontalAlignment = xlCenter

Application.ScreenUpdating = True
End Sub

Hope this Helps.
All the Best.
PAB
:wavey:
 
S

Sammy

Member
Hi PAB,

Thank you very much. Your Sub List_Quadruples() indeed does all that I require - most appreciated.

Cheers
Sammy

PAB said:
Hi Sammy,

Is that what you Wanted?.

All the Best.
PAB
:wavey:
Click to expand...
 
You must log in or register to reply here.

Sidebar

Top