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

 

[Toby123]

I tried running both versions of the code (with and without Alex's helpful idea above) on a powerful remote Vagon PC, so Windows machine this time, and it is still stopping at the same point shown in the attached image. Is anyone feeling generous enough to try running the code for me and seeing what they get? Any chance of forwarding me the results if it works? I will be eternally grateful!

 

[I_know_nuffin]

your setting the array to 550000 which once full halts the code with the error

try resetting the array counter back to the start and fill the array from the begining

 

[Alex Blakenburg]

What happens if you run the original code with just the changes that @johnnyL suggested in his post #7 ?
It seemed to work for me.
(Takes quite a while to run though, you will need a coffee)

Sub ListThemAllViaArray_JohnnyL()
'
    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
    MaxWhiteBallValue = 59
'
    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
    TotalExpectedCominations = 45057474
'
      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

 

[Toby123]

Thank you; would you mind elaborating, not sure what you mean here!

 

[Toby123]

Thank you @I_know_nuffin; would you mind elaborating, not sure what you mean here! Thank you also Alex, when I run it on two different machines it is stopping at the point I mentioned above. Is the code you posted what you ran? If so I will try it again with that. Thank you all for your patience with this!

 

[Alex Blakenburg]

Alex, when I run it on two different machines it is stopping at the point I mentioned above. Is the code you posted what you ran? If so I will try it again with that.

Yes that is the code I ran and it worked fine all be it very slow on my machine.
I think it runs quicker if you comment out the Do Events line, so give that a try.

With the Do Events commented out I have had it run in just under 7 mins. My previous run times have been as long as 15 mins.

 

[Toby123]

Yes that is the code I ran and it worked fine all be it very slow on my machine.
I think it runs quicker if you comment out the Do Events line, so give that a try.

With the Do Events commented out I have had it run in just under 7 mins. My previous run times have been as long as 15 mins.

It worked! Thank you, thank you, thank you! Not sure what was different, but when I copy and pasted your code it ran this time. Probably took about 14 minutes.

 

[Alex Blakenburg]

Thanks for letting us know. All the credit goes to @johnnyL.

PS: If you haven't already done so, try commenting out the Do Events line and see if that doesn't reduce the 14 mins down. It did for me.

 

[Toby123]

Thanks for letting us know. All the credit goes to @johnnyL.

PS: If you haven't already done so, try commenting out the Do Events line and see if that doesn't reduce the 14 mins down. It did for me.

Yes, thank you so much @johnnyL!

 

[Toby123]

Thanks for letting us know. All the credit goes to @johnnyL.

PS: If you haven't already done so, try commenting out the Do Events line and see if that doesn't reduce the 14 mins down. It did for me.

Hi, yes, I didn't try that but will give it a whirl.