Modify Array To Give All Results For UK Lottery

Toby123

New Member
Joined
Sep 6, 2023
Messages
20
Office Version
  1. 365
Platform
  1. MacOS
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:
Your latest code submission yields roughly the same time results as the code that
I submitted. I do like your code though!!!

I just wish we could narrow down why these different Excel versions are yielding such different results.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Update:

I did a reboot & the code from post #30 is averaging out at about 120 seconds. :)
 
Upvote 0
@Eric W, I played with the code a bit more before I have to get some sleep: current time is about 25 seconds faster.

VBA Code:
    Private BallsPerDraw                    As Long
    Private ColCount                        As Long, RowCount                       As Long
    Private CombinationCounter              As Long
    Private TotalExpectedCombinations       As Long
    Private NumberOfBalls                   As Long
'    Private RowsPerColumn                   As Long
    Private StatusBarUpdateCountInterval    As Long
'    Private ResultsArray                    As Variant

Sub CombosEricW_Remix()
'
    Dim t                                   As Single
    t = Timer
'
    Dim BallsDrawn                          As Long
    Dim CombinationString                   As String
'
    Const RowsPerColumn                     As Long = 1000000                           ' <--- Set this to the maximum rows to display per column of results
    BallsPerDraw = 6                                                                    ' <--- Set this to the number of balls to draw each time
    NumberOfBalls = 59                                                                  ' <--- Set this to the total number of balls involved
    StatusBarUpdateCountInterval = 750000                                               ' <--- Set this to the interval of combinations to update the StatusBar
'
    TotalExpectedCombinations = WorksheetFunction.Combin(NumberOfBalls, BallsPerDraw)   ' Calculate the total number of combinations that will be generated
'
    RowCount = 0                                                                        ' Initialize RowCount
    ColCount = 1                                                                        ' Initialize ColCount
    CombinationCounter = 0                                                              ' Initialize CombinationCounter
'
    Application.ScreenUpdating = False                                                  ' Turn ScreenUpdating off
    ActiveSheet.UsedRange.ClearContents                                                 ' Clear previous results
'
    Dim ResultsArray(1 To RowsPerColumn, 1 To 1) As String                              ' Establish the dimensions of ResultsArray
'
    Call GetCombinationsRecursively(0, BallsDrawn, CombinationString, RowsPerColumn, _
            ResultsArray)                                                               ' Pass data needed to generate the combinations
'
    If RowCount > 0 Then Cells(1, ColCount).Resize(RowCount).Value = ResultsArray       ' If there are more results to display then Display the last array to the sheet
'
'    ActiveSheet.UsedRange.Columns.AutoFit
    Range(Columns(1), Columns(ColCount)).ColumnWidth = 16                               ' Set the ColumnWidth of the used columns to 16
'
    Application.StatusBar = False                                                       ' Clear the StatusBar
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
'
    Debug.Print "Routine took " & Timer - t & " seconds."                               ' Display the elapsed time to the 'Immediate' window (CTRL+G) in the VBE window
End Sub

Sub GetCombinationsRecursively(ByVal loc As Long, ByVal BallsDrawn As Long, _
        ByVal CombinationString As String, ByVal RowsPerColumn As String, _
        ByRef ResultsArray() As String)
'
    Dim BallNumber              As Long
'
    If BallsDrawn = BallsPerDraw Then                                                   ' If we have drawn enough balls to complete the combination then ...
        CombinationCounter = CombinationCounter + 1                                     '   Increment CombinationCounter
'
        RowCount = RowCount + 1                                                         '   Increment RowCount
        ResultsArray(RowCount, 1) = CombinationString                                   '   Save the CombinationString to ResultsArray
'
        If RowCount = RowsPerColumn Then                                                '   If RowCount = RowsPerColumn then ...
            Cells(1, ColCount).Resize(RowCount).Value = ResultsArray                    '       Display the results to the sheet
            RowCount = 0                                                                '       Reset RowCount
            ColCount = ColCount + 1                                                     '       Increment ColCount
        End If
'
        If CombinationCounter Mod StatusBarUpdateCountInterval = 0 Then                 '   If StatusBar needs to be updated then ...
            Application.StatusBar = "Result " & CombinationCounter & " on the way to " & _
                    TotalExpectedCombinations & " (" & Format(CombinationCounter / _
                    TotalExpectedCombinations, "###.##%") & ")"                         '       Update the StatusBar with combination count & percentage completed
            DoEvents                                                                    '
        End If
'
        Exit Sub                                                                        '
    End If
'
    For BallNumber = loc + 1 To NumberOfBalls                                           '
        Call GetCombinationsRecursively(BallNumber, BallsDrawn + 1, _
                CombinationString & BallNumber & IIf(BallsDrawn < BallsPerDraw - 1, _
                "-", ""), RowsPerColumn, ResultsArray)                                  '
    Next                                                                                ' Loop back
End Sub

That will probably get you below or around 60 seconds ... you can probably chop the combination array into smaller sections to get faster results even yet. ;)

The biggest time gain was with using a string array instead of a variant, as well as setting column width instead of autofit.
 
Last edited:
Upvote 0
Interesting! I reran my macro from post 30, and it took 88 seconds. I ran your revised version, and it took 72 seconds. I went back to my version and only changed the "As String" part, and it took 70 seconds! Very strange. It's really tough to figure out what really is taking the time, and how to speed it up. Disregarding background processes, there are lots of potential places, but I don't really have time to check them all, so I'm going to leave it at this.

Speed isn't everything by the way. You did a much better job of naming variables and commenting the code. As a professional programmer, I respect that. I tend to get a little sloppy with these quick programs though.

Anyway, interesting topic!
 
Upvote 0
@Eric W, if you didn't replace the 'AutoFit' line of code, you should try that:

Change:
VBA Code:
    ActiveSheet.UsedRange.Columns.AutoFit

to:
VBA Code:
    Range(Columns(1), Columns(ColCount)).ColumnWidth = 16                               ' Set the ColumnWidth of the used columns to 16

That runs about 6 seconds faster on my computer.


I'll look into reducing the array size before I call it quits on this project.
 
Upvote 0
Here is the version that allows the array size to be adjustable. It runs in about 79 seconds on my setup, post #30 code runs in about 120 seconds, so the following code runs about 40 seconds faster on my setup.

VBA Code:
    Private BallsPerDraw                    As Long
    Private ColCount                        As Long, RowCount                       As Long
    Private CombinationCounter              As Long
    Private TotalExpectedCombinations       As Long
    Private NumberOfBalls                   As Long
'    Private RowsPerColumn                   As Long
    Private StatusBarUpdateCountInterval    As Long
'    Private ResultsArray                    As Variant

Sub CombosEricW_Remix_V2()
'
    Dim t                                   As Single
    t = Timer
'
    Dim FirstArrayInColumn                  As Boolean
    Dim BallsDrawn                          As Long
    Dim DisplayStartRow                     As Long
    Dim MaxArrayRows                        As Long
    Dim CombinationString                   As String
'
    Const RowsPerColumn                     As Long = 1000000                           ' <--- Set this to the maximum rows to display per column of results
    BallsPerDraw = 6                                                                    ' <--- Set this to the number of balls to draw each time
    NumberOfBalls = 59                                                                  ' <--- Set this to the total number of balls involved
    MaxArrayRows = 500000                                                               ' <--- Set this to a number that is evenly divisible into RowsPerColumn
    StatusBarUpdateCountInterval = 750000                                               ' <--- Set this to the interval of combinations to update the StatusBar
'
    TotalExpectedCombinations = WorksheetFunction.Combin(NumberOfBalls, BallsPerDraw)   ' Calculate the total number of combinations that will be generated
'
    RowCount = 0                                                                        ' Initialize RowCount
    ColCount = 0                                                                        ' Initialize ColCount
    CombinationCounter = 0                                                              ' Initialize CombinationCounter
'
    Application.ScreenUpdating = False                                                  ' Turn ScreenUpdating off
    ActiveSheet.UsedRange.ClearContents                                                 ' Clear previous results
'
    Dim ResultsArray(1 To RowsPerColumn, 1 To 1) As String                              ' Establish the dimensions of ResultsArray
    FirstArrayInColumn = True                                                           ' Initialize FirstArrayInColumn
'
    Call GetCombinationsRecursively(0, BallsDrawn, CombinationString, RowsPerColumn, _
            ResultsArray, MaxArrayRows, DisplayStartRow, FirstArrayInColumn)            ' Pass data needed to generate the combinations
'
    If RowCount > 0 Then                                                                ' If there are more results to display then ...
        If FirstArrayInColumn = True Then                                               '   If this is the first array being written to the column then ...
            ColCount = ColCount + 1                                                     '       Increment ColCount
            Cells(1, ColCount).Resize(RowCount).Value = ResultsArray                    '       Display the last array to the sheet
        Else                                                                            '   Else ...
            DisplayStartRow = DisplayStartRow + MaxArrayRows                            '       Adjust the DisplayStartRow
            Cells(DisplayStartRow + 1, ColCount).Resize(MaxArrayRows).Value = ResultsArray '    Display ResultsArray to the sheet
        End If
    End If
'
'    ActiveSheet.UsedRange.Columns.AutoFit
    Range(Columns(1), Columns(ColCount)).ColumnWidth = 16                               ' Set the ColumnWidth of the used columns to 16
'
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
'
    Debug.Print "Routine took " & Timer - t & " seconds."                               ' Display the elapsed time to the 'Immediate' window (CTRL+G) in the VBE window
    MsgBox "Routine took " & Timer - t & " seconds."                                    ' Display the elapsed time to a pop up box
'
    Application.StatusBar = False                                                       ' Clear the StatusBar
End Sub

Sub GetCombinationsRecursively(ByVal loc As Long, ByVal BallsDrawn As Long, _
        ByVal CombinationString As String, ByVal RowsPerColumn As Long, _
        ByRef ResultsArray() As String, ByVal MaxArrayRows As Long, _
        ByRef DisplayStartRow As Long, ByRef FirstArrayInColumn As Boolean)
'
    Dim BallNumber              As Long
'
    If BallsDrawn = BallsPerDraw Then                                                   ' If we have drawn enough balls to complete the combination then ...
        CombinationCounter = CombinationCounter + 1                                     '   Increment CombinationCounter
'
        RowCount = RowCount + 1                                                         '   Increment RowCount
        ResultsArray(RowCount, 1) = CombinationString                                   '   Save the CombinationString to ResultsArray
'
        If RowCount = MaxArrayRows Then                                                 '   If RowCount = MaxArrayRows then ...
            If FirstArrayInColumn = True Then                                           '       If this is the first array being written to the column then ...
                ColCount = ColCount + 1                                                 '           Increment ColCount
'
                Cells(1, ColCount).Resize(MaxArrayRows).Value = ResultsArray            '           Display ResultsArray to the sheet
                FirstArrayInColumn = False                                              '           Set the FirstArrayInColumn flag to False
            Else                                                                        '       Else ...
                DisplayStartRow = DisplayStartRow + MaxArrayRows                        '           Adjust the DisplayStartRow
'
                Cells(DisplayStartRow + 1, ColCount).Resize(MaxArrayRows).Value = ResultsArray  '       Display ResultsArray to the sheet
'
                If DisplayStartRow + MaxArrayRows = RowsPerColumn Then                  '           If we have reached the RowsPerColumn limit then ...
                    FirstArrayInColumn = True                                           '               Set the FirstArrayInColumn flag to True
                    DisplayStartRow = 0                                                 '               Reset DisplayStartRow
                End If
            End If
'
            RowCount = 0                                                                '       Reset OutputRow
        End If
'
        If CombinationCounter Mod StatusBarUpdateCountInterval = 0 Then                 '   If StatusBar needs to be updated then ...
            Application.StatusBar = "Result " & CombinationCounter & " on the way to " & _
                    TotalExpectedCombinations & " (" & Format(CombinationCounter / _
                    TotalExpectedCombinations, "###.##%") & ")"                         '       Update the StatusBar with combination count & percentage completed
            DoEvents                                                                    '
        End If
'
        Exit Sub                                                                        '
    End If
'
    For BallNumber = loc + 1 To NumberOfBalls                                           '
        Call GetCombinationsRecursively(BallNumber, BallsDrawn + 1, _
                CombinationString & BallNumber & IIf(BallsDrawn < BallsPerDraw - 1, _
                "-", ""), RowsPerColumn, ResultsArray, MaxArrayRows, DisplayStartRow, FirstArrayInColumn)                                  '
    Next                                                                                ' Loop back
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,164
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top