Thank you so much to Mr Excel for his post on populating a sheet with all the possible lottery results and to johnnyL for his fast array for generating the lottery results for a 44 ball lottery (copied below). I am looking to modify johnnyL's array for the UK lottery which is 59 balls, choose 6. As there are 45,057,474 possible results (!) the array is a great option. I managed to modify Mr Excels macro and it appeared to be working but crashed after two days! I also managed to get some results from johnnyL's code but it started returning errors in the cells. Thank you so much in advance for looking at this for me.
VBA Code:
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 = 44 ' <--- Set to highest value of white ball
'
ArraySlotCount = 0 ' Initialize ArraySlotCount
CombinationCounter = 1 ' Initialize CombinationCounter
MaxRows = 65536 ' 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
For Ball_6 = (Ball_5 + 1) To MaxWhiteBallValue ' 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 & " 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
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
Last edited by a moderator:
