Modify Array To Give All Results For UK Lottery

[Toby123]

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.

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

 

[johnnyL]

I will come up with a faster version, I didn't realize this would be needed, but hey, I am bored so what the heck.

 

[Toby123]

I will come up with a faster version, I didn't realize this would be needed, but hey, I am bored so what the heck.

Thank you! It's been running all night and not competed.

 

[johnnyL]

Are you using 59 balls , 6 balls at a time for a total of 45057474 combinations?

 

[Toby123]

Are you using 59 balls , 6 balls at a time for a total of 45057474 combinations?

Hi Johnny, yes I am. When I posted that it was running and it had not completed, that was for a different thread! Your code did run and complete but seemed to deliver fewer results than I was expecting so it would be great to try a different method. I haven't quite got to the bottom of it yet!

 

[johnnyL]

The following code tests nearly 20% faster on my computer than the original code in Post #1:

If I could get some people to confirm or deny their particular testing environment results, I would appreciate it:

Sub ListThemAllViaArray_MillionRowsPerColumn()                                          ' 146.3859375 avg seconds
'
    Dim StartTime As Double
    StartTime = Timer
'
    Dim ArrayRow            As Long
    Dim Ball_1              As Long, Ball_2                     As Long, Ball_3     As Long
    Dim Ball_4              As Long, Ball_5                     As Long, Ball_6     As Long
    Dim CombinationCounter  As Long, TotalExpectedCombinations  As Long
    Dim MaxWhiteBallValue   As Long
    Dim OutputArrayColumn   As Long
    Dim ResultsPerColumn    As Long
    Dim OutputRow           As Long
    Dim CombinationsArray() As Variant
'
    MaxWhiteBallValue = 59                                                              ' <--- Set to the highest value of the white ball
    Const StatusBarUpdateCountInterval As Long = 750000                                 ' <--- Set this to the count of combinations to update the StatusBar
'
    ResultsPerColumn = 1000000                                                          ' Number of results per column
'
    TotalExpectedCombinations = 45057474                                                ' Set expected # of total combinations
'
    Application.ScreenUpdating = False                                                  ' Turn ScreenUpdating off
'
    ActiveSheet.UsedRange.ClearContents                                                 ' Clear previous results
'
    For Ball_1 = 1 To MaxWhiteBallValue - 5
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 4
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 3
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 2
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue - 1
                        For Ball_6 = (Ball_5 + 1) To MaxWhiteBallValue
                            ArrayRow = ArrayRow + 1                                     '                       Increment ArrayRow
'
                            If ArrayRow Mod ResultsPerColumn = 1 Then                   '                       If this is a first row of a new column then ...
                                OutputArrayColumn = OutputArrayColumn + 1               '                           Increment OutputArrayColumn
                                ReDim CombinationsArray(1 To ResultsPerColumn, 1 To 1)  '                           Set dimensions of CombinationsArray
                            End If
'
                            CombinationsArray((ArrayRow - 1) Mod ResultsPerColumn + 1, 1) = _
                                    Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & _
                                    "-" & Ball_5 & "-" & Ball_6                         '                       Save the combination into CombinationsArray
'
                            CombinationCounter = CombinationCounter + 1                 '                       Increment CombinationCounter
'
                            If CombinationCounter Mod StatusBarUpdateCountInterval _
                                    = 0 Then                                            '                       If CombinationCounter = StatusBarUpdateCountInterval then ...
                                Application.StatusBar = "Result " & CombinationCounter & _
                                        " on the way to " & TotalExpectedCombinations   '                           Update the StatusBar with the progress
'
                                DoEvents                                                '                           DoEvents
                            End If
'
                            OutputRow = OutputRow + 1                                   '                       Increment OutputRow
'
                            If OutputRow = ResultsPerColumn Then                        '                       If OutputRow = ResultsPerColumn then ...
                                Range(Cells(1, OutputArrayColumn), Cells(OutputRow, _
                                        OutputArrayColumn)) = CombinationsArray         '                           Dump CombinationsArray to the sheet
'
                                Erase CombinationsArray                                 '                           Erase CombinationsArray
                                ArrayRow = 0                                            '                           Reset ArrayRow
                                OutputRow = 0                                           '                           Reset OutputRow
                            End If
                        Next                                                            '                   Loop back
                    Next                                                                '               Loop back
                Next                                                                    '           Loop back
            Next                                                                        '       Loop back
        Next                                                                            '   Loop back
    Next                                                                                ' Loop back
'
    Range(Cells(1, OutputArrayColumn), Cells(OutputRow, OutputArrayColumn)) = _
            CombinationsArray                                                           ' Dump contents of last array to the sheet
'
    ActiveSheet.UsedRange.Columns.AutoFit                                               ' Resize all columns to fit the data within them
'
    Erase CombinationsArray                                                             ' Erase contents of array
'
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
'
    Debug.Print "Time to complete ListThemAllViaArray_MillionRowsPerColumn was " & _
            Timer - StartTime & " seconds."                                             ' Display timing result to the 'Immediate' window (CTRL+G) in VBE
    MsgBox "Time to complete ListThemAllViaArray_MillionRowsPerColumn was " & Timer - _
            StartTime & " seconds."                                                     ' Display timing result to pop up window
'
    Application.StatusBar = False                                                       ' Clear StatusBar
End Sub

 

[Alex Blakenburg]

The following code tests nearly 20% faster on my computer than the original code in Post #1:

If I could get some people to confirm or deny their particular testing environment results, I would appreciate it:

Took 32 mins on my machine. Which is slower by x2

 

[johnnyL]

@Alex Blakenburg, I don't get it.

I am only running 32Bit versions of Excel:

2013 - 146.3859375 avg seconds
365 - 173.3177083333333 avg seconds

 

[Eric W]

I swear I'll never understand the fascination in printing out millions of combinations. If you search this forum, you'll find lots of examples. And so, here I'll add my own 2 cents!

For reference, I ran the code in post 25, and it took 318 seconds. Excel 2021, 64 bit, fast machine. Then I rewrote the macro using recursion. That made it shorter, more flexible, and faster:

Public RowCount As Long
Public ColCount As Long
Public Results As Variant
Public LinesPerRow As Long
Public NumberOfBalls As Long
Public NumberChosen As Long

Sub Combos()

t = Timer

    NumberOfBalls = 59
    NumberChosen = 6
    LinesPerRow = 1000000
    
    RowCount = 0
    ColCount = 1
    ReDim Results(1 To LinesPerRow, 1 To 1)
    
    Call recur(0, 0, "")
    
    If RowCount > 0 Then
        Cells(1, ColCount).Resize(RowCount).Value = Results
    End If
    
Debug.Print "Routine took " & Timer - t & " seconds."
End Sub

Sub recur(ByVal loc As Long, ByVal depth As Long, ByVal str As String)
Dim i As Long

    If depth = NumberChosen Then
        RowCount = RowCount + 1
        Results(RowCount, 1) = str
        If RowCount = LinesPerRow Then
            Cells(1, ColCount).Resize(RowCount).Value = Results
            RowCount = 0
            ColCount = ColCount + 1
        End If
        Exit Sub
    End If
        
    For i = loc + 1 To NumberOfBalls
        Call recur(i, depth + 1, str & i & IIf(depth < NumberChosen - 1, "-", ""))
    Next i
        
End Sub

This took 84 seconds to run. I hope this didn't muddy the waters too much!

 

[johnnyL]

@Eric W Thank you for that alternative approach, I like it!

However ... when I compare apples to apples, I don't see where your code is any faster than what I submitted most recently.

What I am getting at is the code I submitted clears previous results, it also autofits the column results, Can you please retest your results, when you add those stipulations to make it a better comparison to the code that I submitted?

 

[Eric W]

Sure. I added those 2 changes, using the same lines of code you used, and it added about 3 seconds to the time, 88 up from 85. I also noticed that you updated the status bar too, so I did that, and it didn't seem to affect the time at all. I tried a few other things to try to speed it up some, but couldn't find anything significant. I added a percentage to the status bar update though. Here's the updated macro, changes in red:

Public RowCount As Long
Public ColCount As Long
Public Results As Variant
Public LinesPerRow As Long
Public NumberOfBalls As Long
Public NumberChosen As Long
Public TotalExpectedCombinations As Long
Public StatusBarUpdateCountInterval As Long
Public CombinationCounter As Long

Sub Combos()

t = Timer

    NumberOfBalls = 59
    NumberChosen = 6
    LinesPerRow = 1000000
    TotalExpectedCombinations = WorksheetFunction.Combin(NumberOfBalls, NumberChosen)
    StatusBarUpdateCountInterval = 750000
    CombinationCounter = 0
    ActiveSheet.UsedRange.ClearContents
 
    RowCount = 0
    ColCount = 1
    ReDim Results(1 To LinesPerRow, 1 To 1)
    Application.ScreenUpdating = False
 
    Call recur(0, 0, "")
 
    If RowCount > 0 Then
        Cells(1, ColCount).Resize(RowCount).Value = Results
    End If
    ActiveSheet.UsedRange.Columns.AutoFit
    Application.StatusBar = False
    Application.ScreenUpdating = False

Debug.Print "Routine took " & Timer - t & " seconds."
End Sub

Sub recur(ByVal loc As Long, ByVal depth As Long, ByVal str As String)
Dim i As Long

    If depth = NumberChosen Then
        RowCount = RowCount + 1
        CombinationCounter = CombinationCounter + 1
        Results(RowCount, 1) = str
        If RowCount = LinesPerRow Then
            Cells(1, ColCount).Resize(RowCount).Value = Results
            RowCount = 0
            ColCount = ColCount + 1
        End If
        If CombinationCounter Mod StatusBarUpdateCountInterval = 0 Then
            Application.StatusBar = "Result " & CombinationCounter & " on the way to " & _
            TotalExpectedCombinations & " (" & Format(CombinationCounter / TotalExpectedCombinations, "###.##%") & ")"
            DoEvents
        End If
        Exit Sub
    End If
     
    For i = loc + 1 To NumberOfBalls
        Call recur(i, depth + 1, str & i & IIf(depth < NumberChosen - 1, "-", ""))
    Next i
     
End Sub

When you said that you didn't see that this code is any faster than the code you posted, you mean that you ran both versions on your machine, and the times were similar? That's surprising, given the difference on mine. There could be differences on our PCs. For example, I have a LOT of RAM on mine, and a SSD. If you have less, then Windows might have to resort to some swap file manipulations, which could slow things down. There are a lot of reasons why it's hard to compare run times over multiple devices.