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

 

[Phuoc]

Dim CombinationsArray(1 To 65536) As Variant
' If CombinationCounter Mod 550000 = 0 Then

Try change:

Dim CombinationsArray(1 To 65536)

To:

Dim CombinationsArray(1 To 550000)

 

[Toby123]

Try change:

To:

Thank you! That worked better but I'm still getting errors. It is stopping running at 44550000 results and giving #N/A results in the boxes. Do I need to increase MaxRows = 65536 to 550000 as well? I am noob so am probably making some rookie errors here!

Here is the code that I am running;



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 550000) As Variant
'
MaxWhiteBallValue = 59 ' <--- 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 = 45057474 ' 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

 

[Phuoc]

Do I need to increase MaxRows = 65536 to 550000 as well?

Yes, you need to change it.

 

[Toby123]

Yes, you need to change it.

Thank you, I have changed it and run it again and it is still stopping short with the errors coming in at line 25,713. The last entry is

at CD, 25712.

 

[Alex Blakenburg]

The most likely cause of that is the Transpose has an upper limit of 65,536 at which point it start filling the array from scratch again.

Try changing these 4 lines to what I have below:

    ' Change array from 1 to 2 dimensional
    Dim CombinationsArray(1 To 550000, 1 To 1)   As Variant
    MaxRows = 550000
                            ' Add 2nd Dimension eg column = 1
                            CombinationsArray(ArraySlotCount, 1) = Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & "-" & Ball_5 & "-" & Ball_6
                               ' Array is now 2 dimensional and no longer needs the Transpose
                                Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = CombinationsArray

 

[johnnyL]

@Toby123, I set the script up so that it is easily modified if desired.

You would only need to change two lines of the code to accomplish what you want, which is 59 balls and the total number of combinations expected.

Change:

    MaxWhiteBallValue = 44                                                                                  ' <--- Set to highest value of white ball

to:

    MaxWhiteBallValue = 59                                                                                  ' <--- Set to highest value of white ball

And then change:

    TotalExpectedCominations = 7059052                                                                      ' Set expected # of total combinations

to:

    TotalExpectedCominations = 45057474                                                                    ' Set expected # of total combinations

That is all you would need to change, unless you want to get into the way the results are displayed.

 

[Toby123]

@Toby123, I set the script up so that it is easily modified if desired.

You would only need to change two lines of the code to accomplish what you want, which is 59 balls and the total number of combinations expected.

Change:

    MaxWhiteBallValue = 44                                                                                  ' <--- Set to highest value of white ball

to:

    MaxWhiteBallValue = 59                                                                                  ' <--- Set to highest value of white ball

And then change:

    TotalExpectedCominations = 7059052                                                                      ' Set expected # of total combinations

to:

    TotalExpectedCominations = 45057474                                                                    ' Set expected # of total combinations

That is all you would need to change, unless you want to get into the way the results are displayed.

Thank you, yes. I change these but was still getting the error for some reason. I wonder if it is because I am on a Mac?

 

[Toby123]

The most likely cause of that is the Transpose has an upper limit of 65,536 at which point it start filling the array from scratch again.

Try changing these 4 lines to what I have below:

    ' Change array from 1 to 2 dimensional
    Dim CombinationsArray(1 To 550000, 1 To 1)   As Variant
    MaxRows = 550000
                            ' Add 2nd Dimension eg column = 1
                            CombinationsArray(ArraySlotCount, 1) = Ball_1 & "-" & Ball_2 & "-" & Ball_3 & "-" & Ball_4 & "-" & Ball_5 & "-" & Ball_6
                               ' Array is now 2 dimensional and no longer needs the Transpose
                                Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn)) = CombinationsArray

Thank you for this, I made the changes and ran the code and it still stops but without giving any errors in the cells this time. I have attached a screen capture of the point at which it stops. I think I might try using the replace function or something similar to create the rest of the cells from the ones I have.

 

[Toby123]

Thank you for this, I made the changes and ran the code and it still stops but without giving any errors in the cells this time. I have attached a screen capture of the point at which it stops. I think I might try using the replace function or something similar to create the rest of the cells from the ones I have.

I have just realised that isn't going to work. I was hoping to replace the first number in each cell but it's actually far more complicated than that. Will try and run the code somewhere else.