Mega Millions All combinations

[ciscoaudrey]

Hello to all first of all. I was following a thread about mrexcel and running a script to generate into excel all possible combinations of US mega millions lottery. Yes i know what your thinking; But WHYYYYYYYYYYYYYYYYYYYY? Theres over 300 million combinations. Well honestly, Why not? Once i have them, later on in the near future i will be implementing some type of number analysis with that list and the already drawn numbers from past history. So i was advised by JohnnyL at thread 2441 to post a new thread so here it is. Title of that thread was Excel List All Lottery Combinations-2441. So JohnnyL, after using your first code and modifying just a few things to work with mega millions I got some issues. First thing is it will not print combinations past the 65,536 cell, after that it displays #N/A on every cell all the way to 1,048,576 then on column B1 combinations continue where 1,048,576 should of left off. So I then changed parameters on the code on combinationsArray to 65536 how your original code was and max combinations it goes to is 280,500,000 where total should be the 302,575,350 possibilities, unless I'm mistaken. It stops at combo 65,66,67,68,69,25. Can you or anyone help me on this issue, I'm new to programming and doing this just to have the entire combination's list. By the way I did try the code that mr excel put in the first post but computer never finishes its been like one 3 days straight and only at about 30 million combinations but it works and prints the way it should.


Sub ListThemAllViaArray()
'
Dim ArraySlotCount As Long
Dim Ball_1 As Long, Ball_2 As Long, Ball_3 As Long, Ball_4 As Long, Ball_5 As Long, Ball_6 As Long
Dim CombinationCounter As Long
Dim MaxRows As Long, ThisRow As Long
Dim MaxWhiteBallValue As Long
Dim TotalExpectedCominations As Long
Dim ThisColumn As Long
Dim CombinationsArray(1 To 1048576) As Variant
'
MaxWhiteBallValue = 70 ' <--- Set to highest value of white ball
'
ArraySlotCount = 0 ' Initialize ArraySlotCount
CombinationCounter = 1 ' Initialize CombinationCounter
MaxRows = 1048576 ' Set to maximum number of slots in Array
ThisColumn = 1 ' Initialize 1st column to display results in
ThisRow = 0 ' Initialize row counter
TotalExpectedCominations = 302,575,350 ' Set expected # of total combinations
'
Application.ScreenUpdating = False ' Turn Screen Updating off
'
For Ball_1 = 1 To MaxWhiteBallValue - 5 ' Establish loop for 1st ball
For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 4 ' Establish loop for 2nd ball
For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 3 ' Establish loop for 3rd ball
For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 2 ' Establish loop for 4th ball
For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue - 1 ' Establish loop for 5th ball
For Ball_6 = 1 To 25 ' Establish loop for 6th ball
'
ArraySlotCount = ArraySlotCount + 1 ' Increment ArraySlotCount
'
' Save combination into array
CombinationsArray(ArraySlotCount) = Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & "-" & Ball_5 & "-" & Ball_6
CombinationCounter = CombinationCounter + 1 ' Increment CombinationCounter
'
If CombinationCounter Mod 550000 = 0 Then ' If CombinationCounter = 550k then ...
' Update StatusBar about every 10 seconds
Application.StatusBar = "Result " & CombinationCounter & " out of " & TotalExpectedCominations
'
DoEvents ' DoEvents
End If
'
ThisRow = ThisRow + 1 ' Increment row counter
'
If ThisRow = MaxRows Then ' If row count=array max slots
' Dump contents of CombinationsArray to the screen
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray)
'
Erase CombinationsArray ' Erase contents of array
ArraySlotCount = 0 ' Reset ArraySlotCount
ThisRow = 0 ' Reset row counter
ThisColumn = ThisColumn + 1 ' Increment column counter
End If
Next
Next
Next
Next
Next
Next
'
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray) ' Dump contents of last array to the screen
Columns.AutoFit ' Resize all columns to fit the data within them
'
Application.ScreenUpdating = True ' Turn Screen Updating back on
End Sub

 

[Z51]

Quite a few folks have done statistical analysis on lotteries, and I'd wager none of them have ever won.

https://www.usamega.com/mega-millions/statistics

Export all MegaMillions results back to 2002 from here: Lottery Mega Millions Winning Numbers: Beginning 2002 | State of New York

 

[johnnyL]

I, also, am not sure why you would want every single combination possible, but if you do, I would suggest that you not over complicate the issue. Generate all of the the 1 thru 70 combinations of 5 balls (12,103,014 combinations) & then duplicate those results 25 times.

 

[ciscoaudrey]

I thank you both for the links and info. Those statistics do not have what I'm looking to do. But its not a matter of overcomplicating its a matter of Why will that code not work out? Are there some parameters that are not correct on it? why will it only reach 280 million combinations? If you guys don't mind giving me a hand on this code I would appreciate it. Thanks..

 

[johnnyL]

It sounds like the code you created is not correct if you don't get the correct results.

If you read what I suggested, you only need to create the 12,103,014 combinations for the 70 balls, 5 at a time. After that you can duplicate the results to achieve the 302,575,350 combinations.

 

[ciscoaudrey]

tried the code modifying it to only 5 balls and the printout will not go over the 65536 line. after that it jumps to next column and if I make max rows of 1048576 it displays the famous #N/A from 65536 to 1048576. Is excel not able to go past the 65k limit to print results out or am I missing something here. I want it to fill all the way to rows max as to old have 13 columns.

Sub ListThemAllViaArray()
'
Dim ArraySlotCount As Long
Dim Ball_1 As Long, Ball_2 As Long, Ball_3 As Long, Ball_4 As Long, Ball_5 As Long, Ball_6 As Long
Dim CombinationCounter As Long
Dim MaxRows As Long, ThisRow As Long
Dim MaxWhiteBallValue As Long
Dim TotalExpectedCominations As Long
Dim ThisColumn As Long
Dim CombinationsArray(1 To 65536) As Variant
'
MaxWhiteBallValue = 70 ' <--- Set to highest value of white ball
'
ArraySlotCount = 0 ' Initialize ArraySlotCount
CombinationCounter = 1 ' Initialize CombinationCounter
MaxRows = 1048576 ' Set to maximum number of slots in Array
ThisColumn = 1 ' Initialize 1st column to display results in
ThisRow = 0 ' Initialize row counter
TotalExpectedCominations = 7059052 ' Set expected # of total combinations
'
Application.ScreenUpdating = False ' Turn Screen Updating off
'
For Ball_1 = 1 To MaxWhiteBallValue - 5 ' Establish loop for 1st ball
For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 4 ' Establish loop for 2nd ball
For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 3 ' Establish loop for 3rd ball
For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 2 ' Establish loop for 4th ball
For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue - 1 ' Establish loop for 5th ball

ArraySlotCount = ArraySlotCount + 1 ' Increment ArraySlotCount
'
' Save combination into array
CombinationsArray(ArraySlotCount) = Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & "-" & Ball_5
CombinationCounter = CombinationCounter + 1 ' Increment CombinationCounter
'
If CombinationCounter Mod 550000 = 0 Then ' If CombinationCounter = 550k then ...
' Update StatusBar about every 10 seconds
Application.StatusBar = "Result " & CombinationCounter & " on way to " & TotalExpectedCominations
'
DoEvents ' DoEvents
End If
'
ThisRow = ThisRow + 1 ' Increment row counter
'
If ThisRow = MaxRows Then ' If row count=array max slots
' Dump contents of CombinationsArray to the screen
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray)
'
Erase CombinationsArray ' Erase contents of array
ArraySlotCount = 0 ' Reset ArraySlotCount
ThisRow = 0 ' Reset row counter
ThisColumn = ThisColumn + 1 ' Increment column counter
End If

Next
Next
Next
Next
Next
'
Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = Application.Transpose(CombinationsArray) ' Dump contents of last array to the screen
Columns.AutoFit ' Resize all columns to fit the data within them
'
Application.ScreenUpdating = True ' Turn Screen Updating back on
End Sub

 

[montecarlo2012]

The problem it is not the combinations but how to pick the numbers, and better use wheels instead of a combination generator.
A code able to pick at least the 5 without the megaball and be right, it is almost like the code they use for gps, so many filters, parameters, discrete math,
test all the coefficient trend lines on many ranges and so on, but remember nothing is impossible, and random exists in the eye of the beholder.

 

[johnnyL]

Here is some code to generate all of the 5 ball combinations of the MegaMillions for you.

The code generates all of the 5 ball combinations into a very long array. It then copies those results over to another array that can be displayed on one sheet. It then removes all of the zeros from the sheet that the array generated. All you would have to do, if you wanted, is to insert the Megaball column value for the Megaball that you want to display for the sheet.

Be advised that each sheet will require about 300MB of space should you choose to save the results. So if you decided to duplicate the generated sheet, one for each Megaball, you would be looking at a file size of about 7.5 GB. Good luck opening/saving/closing that.

Sub MegaMillionsAllCombinations()
'
    Dim StartTime               As Double
    StartTime = Timer
'
    Dim ArrayRanges             As Long, RangeCount             As Long
    Dim AmountOfNumbersChosen   As Long, MaxAmountOfNumbers     As Long
    Dim SourceColumn            As Long, OutputColumn           As Long, StartOutputColumn      As Long
    Dim SourceRow               As Long, OutputRow              As Long
    Dim OutputArray()           As Long, SourceArray()          As Long
    Dim HeaderArray             As Variant
'
    AmountOfNumbersChosen = 5                                                           ' <--- Set this to the AmountOfNumbersChosen
    MaxAmountOfNumbers = 70                                                             ' <--- Set this to the MaxAmountOfNumbers
'
    SourceArray = GetCombinations(MaxAmountOfNumbers, AmountOfNumbersChosen)            ' Load SourceArray with all non repeating 5 out of 70 combinations
'
' Time to generate all combinations = 6.828125 Seconds.
'
'---------------------------------------------------------------------------------------
'
    ArrayRanges = Application.WorksheetFunction.RoundUp(UBound(SourceArray, 1) _
            / 1000000, 0)                                                               ' Calculate # of loops needed to cycle through all combos
'
    ReDim OutputArray(1 To 1000000, 1 To (AmountOfNumbersChosen + 2) * ArrayRanges)     ' Set the # of rows & columns needed for the OutputArray
'
    OutputRow = 1                                                                       ' Initialize the OutputRow
    StartOutputColumn = 1                                                               ' Initialize the StartOutputColumn
'
    For SourceRow = 1 To UBound(SourceArray, 1)                                         ' Loop through all generated 5 ball combinations of 70 balls total
        OutputColumn = StartOutputColumn                                                '   Set the OutputColumn  = StartOutputColumn
'
        For SourceColumn = 1 To AmountOfNumbersChosen                                   '   Loop through the SourceArray columns
            OutputArray(OutputRow, OutputColumn) = SourceArray(SourceRow, SourceColumn) '       Load SourceArray combination data to OutputArray
'
            OutputColumn = OutputColumn + 1                                             '       Increment the OutputColumn
        Next                                                                            '   Loop back
'
        OutputRow = OutputRow + 1                                                       '   Increment the OutputRow
'
        If OutputRow > 1000000 Then                                                     '   If we have copied 1 million data rows to OutputArray then ...
            OutputRow = 1                                                               '       Reset OutputRow
            StartOutputColumn = StartOutputColumn + 7                                   '       Increment the StartOutputColumn
        End If
    Next                                                                                ' Loop back
'
' Time to create OutputArray = 29.83984375 Seconds.
'
'---------------------------------------------------------------------------------------
'
    Application.ScreenUpdating = False                                                  ' Turn ScreenUpdating off
    ActiveSheet.UsedRange.ClearContents                                                 ' Clear any previous results
'
    HeaderArray = Array("Ball 1", "Ball 2", "Ball 3", "Ball 4", "Ball 5", "Mega Ball")  ' Establish array of Headers to write to sheet
    StartOutputColumn = 1                                                               ' Initialize StartOutputColumn
'
    For RangeCount = 1 To ArrayRanges                                                   ' Loop through needed ranges of data
        Cells(1, StartOutputColumn).Resize(1, UBound(HeaderArray) + 1) = HeaderArray    '   Write the Header array to sheet for each range
        StartOutputColumn = StartOutputColumn + UBound(HeaderArray) + 2                 '   Increment the StartOutputColumn
    Next                                                                                ' Loop back
'
    Range("A2").Resize(UBound(OutputArray, 1), UBound(OutputArray, 2)) = OutputArray    ' Display results to sheet
'
' Time to display OutputArray = 119.23828125 Seconds.
'
'---------------------------------------------------------------------------------------
'
    ActiveSheet.UsedRange.NumberFormat = "0;-0;;@"                                      ' Format the cells of the OutputSheet to hide zero values
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."                 ' Display time to complete to 'Immediate' window Ctrl+G in VBE
    MsgBox "Time to complete = " & Timer - StartTime & " seconds."                      ' Display time to complete in a message box
'
' Total Time to complete = 187.7265625 seconds.
'
End Sub


Function GetCombinations(lNumber As Long, lNoChosen As Long) As Long()

    Dim lOutput() As Long, lCombinations As Long
    Dim i As Long, j As Long, k As Long
   
    lCombinations = WorksheetFunction.Combin(lNumber, lNoChosen)
    ReDim lOutput(1 To lCombinations, 1 To lNoChosen)
   
    For i = 1 To lNoChosen
        lOutput(1, i) = i
    Next i
   
    For i = 2 To lCombinations
        For j = 1 To lNoChosen
            lOutput(i, j) = lOutput(i - 1, j)
        Next j
        For j = lNoChosen To 1 Step -1
            lOutput(i, j) = lOutput(i, j) + 1
            If lOutput(i, j) <= lNumber - (lNoChosen - j) Then Exit For
        Next j
        For k = j + 1 To lNoChosen
            lOutput(i, k) = lOutput(i, k - 1) + 1
        Next k
    Next i
   
    GetCombinations = lOutput
End Function

The following is the timing results for my old laptop:

Time to generate all combinations = 6.828125 Seconds.
       Time to create OutputArray = 29.83984375 Seconds.
      Time to display OutputArray = 119.23828125 Seconds.
         Time to remove all zeros = 31.8203125 seconds.
                                    -----------
           Total Time to complete = 187.7265625 seconds.

You may notice, about 2/3 of the time was used just for displaying the results to the sheet.

More modern computers would most likely yield faster results than what I witnessed when I ran the program just once.

 

[ciscoaudrey]

Thanks johnny. Yeah as of yesterday im looking at a Gigantic file that takes A Long time to load and to do any modifications to it would probably be a nightmare. I would need a pc with plenty of memory to manage working with gigs of numbers. So yes i will implement the 5 ball only. I will try out the code u provided later at night. Thanks...

 

[johnnyL]

Please let us know your results.