Excel List All Lottery Combinations - 2441

Reid would like to list all 6-number combinations of the numbers 1 to 44. For example, 1-2-3-4-5-6, 1-2-3-4-5-7, and so on up to 39-40-41-42-43-44. The first thing to realize is that all lottery combinations are a lot of numbers. Over 7 million possibilities according to the COMBIN function in Excel. (For Power Ball, there are 292 million combinations!). Listing all combinations will be difficult because Excel only includes 1,048,576 rows.
In this video, I show how to enable Macros in your version of Excel and then the macro code to list all possible combinations.

Here is the code you can copy into your project.

Sub ListThemAll()
    TC = 1
    TR = 1
    Ctr = 1
    MaxRows = Rows.Count
    EndCell = 7059052
    Application.ScreenUpdating = False
    For a = 1 To 39
    For b = (a + 1) To 40
    For c = (b + 1) To 41
    For d = (c + 1) To 42
    For e = (d + 1) To 43
    For f = (e + 1) To 44
    Application.StatusBar = Ctr & " on way to " & EndCell
    Cells(TR, TC).Value = a & "-" & b & "-" & c & "-" & d & "-" & e & "-" & f
    Ctr = Ctr + 1
    If Ctr Mod 25000 = 0 Then
        Cells(TR - 20, TC).Select
        Application.ScreenUpdating = True
        ThisWorkbook.Save
        Application.ScreenUpdating = False
    End If
    TR = TR + 1
    If TR = MaxRows Then
        TR = 1
        TC = TC + 1
    End If
    Next f
    Next e
    Next d
    Next c
    Next b
    Next a
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Transcript of the video:

Learn Excel from MrExcel Podcast episode 2441: List All Lottery Combinations.
Welcome back to the MrExcel Netcast. I'm Bill Jelen.
Today’s question sent in by Reid.
Wants to find all combinations of six numbers from 1 to 44.
For example, 1-2-3-4-5-6, 1-2-3-4-5-7 all the way up to 39-40-41-42-43-44. Obviously a lottery question.
You know the first thing we have to be aware of is there's a lot of them right.
That's why it's so hard to win the lottery.
If you have 44 numbers chosen 6 at a time that is 7,059,052. So you want to get a list of seven million items.
The first problem is we don't have that many rows in Excel.
We only have 1,048,576.
So the solution is going to fill all of column A through F and maybe even part of G Rather than start to type 1-2-3-4-5-6 like that, let's switch over to VBA.
Now if you've never used VBA before, you have to do this: alt T for Tools, M for Macro, S for Security.
Change this from the top setting down to the second setting.
If you don't have the Developer tab, right click, Customize the Ribbon, turn on the Developer tab.
Once you have the Developer tab, then we can go into Visual Basic like that.
So you'll see in your Project Explorer. View, Project Explorer or Ctrl+R.
There is a list of all the sheets and we're going to say Insert, Module to get a new module.
And then we're going to paste the code. The code will be down in the YouTube description.
Just copy it and paste it. So let's talk about this.
This is called ListThemAll. ThisColumn we are going to start in Column One.
We're going to start in row one. And just have a counter to count how many we have.
As soon as we get to roll 1,048,576, we want to move to the next column.
So Max Rows in the spreadsheet as Rows.Count.
Oh my God, don't try this if you're back in Excel 2003 with only 65536 rows. I guess it would work.
To speed things up, turn off screen updating.
And we know, if the digits are arranged in sequence, can't be higher than 39.
Because 39-40-41-42-43-44 would be the very last number.
So for the first the first number chosen, it's going to be from 1 to 39. For a = 1 to 39.
And then for B, it's going to be one number higher than whatever A is.
So the first time through A is going to be one, and we're going to run from 2 to 40.
But eventually A is going to be 27 are we are going to run from 28 to 40.
That'll be easier there. For C = 1 + b to 41.
D is C + 1 to 42. E is D + 1 to 43.
F is E plus one to 44. Alright, this row and this column.
The first time through, Cells(1,1) is going to be equal to.
We are going to concatenate together, whatever A is with a dash B dash C dash.
All the way on out to F. No dash after F.
Counter equals counter plus one. Now, this takes some time.
On one computer here it took about an hour to generate all of these, and I'm not going to make you watch that.
But it's very tedious to not know if it's working or if it's hung up.
So every 25,000 or so. Counter equals counter plus one.
If the counter divided by 25,000, if that remainder is equal to zero, then save the workbook.
And then I can look in Windows Explorer and see that it's counting up. Add 1 to the row.
If the row becomes equal to Max Row, then set the row back to one and this column equals this column plus one. End if there.
And then it just goes backwards Next F, E, D, C, B, A.
Now I don't want this whole thing to run, but let's just get to the 1st 25,000.
That'll give us a great indication of what's going on.
So we have a macro called ListThemAll. I will close the VBA module. Close the VBA window.
And then here list the macros. We find ListThemAll and click run.
Now that was fast. That's really encouraging.
The 1st 25,000 happened that fast. Let's switch back to Excel and we got 1-2-3-4-5-6.
1-2-3-4-5-7. Let's see how far we got in the first 25,000.
We are up to 1-2-5-13-25-30. Alright, so that's good.
That means that we can just turn off this breakpoint and let the thing run.
But as I mentioned, it's going to take over an hour for the whole thing to run.
Luckily, I've already run it just to see if it would work.
Alright, here's the one that finished. So we have A1 to A1048575.
If I choose all of these cells, including column G.
And we look down here the count 7,059,052, which I think is pretty much what I predicted.
So there are all the lottery combinations.
Now I know lotteries are different depending on where you are.
For example, Powerball in 2021, five balls from 1 to 69.
So there's the first five loops from 69 back to 65 and then the Powerball can be from 1 to 26. It's a different color ball, the red ball.
So that's how you would code up the Powerball.
You can adapt this for just about any lottery system.
If you want learn about macros, check out the book that Tracy and I wrote Excel 2016 VBA and Macros.
There's actually a 2019 version and soon a 2021 version. They're all pretty much the same.
Not a lot of change in VBA over the years.
If you like these videos, please, down below. Like, Subscribe, and Ring the bell.
Feel free to post any questions or comments down in the YouTube comments below.
Well, I wan to thank Reid for sending that question and I want to thank you for stopping by.
We'll see you next time for another netcast from MrExcel. Hit it, Nancy!

 

[johnnyL]

Why not use an array and reduce the number of times that you access the StatusBar?

The following code Generates all of the combinations in about 2.5 minutes in 32 bit Excel 2013:

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

 

[Samgraphics]

Why not use an array and reduce the number of times that you access the StatusBar?

The following code Generates all of the combinations in about 2.5 minutes in 32 bit Excel 2013:

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

Hi JonhnyL Thank you for this post. It worked like a charm. So did the vba from Mr Excel. The set of numbers I wanted to return all the combinations to are from 1 - 35 with 5 number combinations which is only just over 324 thousand. So I changed a few things and it was done.

However I'm a newbie to excel, so I was wondering how I would go about this. I don't want the results concatenated. I want each number in it's own column, so five columns and since excel has a max of over a million rows the entire list should be able to fit. I found another code that also returns all combinations and it works fine for up to 25 numbers, 1 - 25 but from the moment I go above that it returns a #value error.

here's the code
Public result() As Variant

Function Combinations(rng As Range, n As Single)

rng1 = rng.Value

ReDim result(n - 1, 0)

Call Recursive(rng1, n, 1, 0)

ReDim Preserve result(UBound(result, 1), UBound(result, 2) - 1)

Combinations = Application.Transpose(result)

End Function

Function Recursive(r As Variant, c As Single, d As Single, e As Single)

Dim f As Single

For f = d To UBound(r, 1)

result(e, UBound(result, 2)) = r(f, 1)

If e = (c - 1) Then

ReDim Preserve result(UBound(result, 1), UBound(result, 2) + 1)

For g = 0 To UBound(result, 1)

result(g, UBound(result, 2)) = result(g, UBound(result, 2) - 1)
Next g

Else

Call Recursive(r, c, f + 1, e + 1)
End If

Next f

End Function


For this code I use =combinations(A1:A25,5) then hold ctrl+shift and enter.

Here's an image of what the results I'm trying to achieve look like. Hoping you can help me out..

Thank you in advance.

 

[johnnyL]

Completion in about 3 seconds ...

Sub List5of35ViaArray()
'
    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
    Dim ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ThisRow                         As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 5                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 35                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ThisRow = 0                                                                                             ' Initialize row counter
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' Expected # of total combinations
'
    Application.ScreenUpdating = False                                                                      ' Turn Screen Updating off
'
    For Ball_1 = 1 To MaxWhiteBallValue - 4                                                                 ' Establish loop for 1st ball
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 3                                                  '   Establish loop for 2nd ball
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 2                                              '       Establish loop for 3rd ball
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 1                                          '           Establish loop for 4th ball
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue                                          '               Establish loop for 5th ball
                            ArraySlotCount = ArraySlotCount + 1                                             '                       Increment ArraySlotCount
'
'                           Save combination into array
                            CombinationsArray(ArraySlotCount, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
'
                            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 + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ThisRow = 0                                                                 '                           Reset row counter
                                ThisColumn = ThisColumn + ColumnIncrement                                   '                           Increment column counter
                            End If
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray           ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub

 

[BSALV]

it's a pity, most explanation is in dutch, but 4 methods for making those combinations and they are also very fast

VBA voor smarties: Combinaties

www.snb-vba.eu

 

[Samgraphics]

Hi Joh

Completion in about 3 seconds ...

Sub List5of35ViaArray()
'
    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
    Dim ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ThisRow                         As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 5                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 35                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ThisRow = 0                                                                                             ' Initialize row counter
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' Expected # of total combinations
'
    Application.ScreenUpdating = False                                                                      ' Turn Screen Updating off
'
    For Ball_1 = 1 To MaxWhiteBallValue - 4                                                                 ' Establish loop for 1st ball
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 3                                                  '   Establish loop for 2nd ball
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 2                                              '       Establish loop for 3rd ball
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 1                                          '           Establish loop for 4th ball
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue                                          '               Establish loop for 5th ball
                            ArraySlotCount = ArraySlotCount + 1                                             '                       Increment ArraySlotCount
'
'                           Save combination into array
                            CombinationsArray(ArraySlotCount, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
'
                            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 + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ThisRow = 0                                                                 '                           Reset row counter
                                ThisColumn = ThisColumn + ColumnIncrement                                   '                           Increment column counter
                            End If
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray           ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub
[/CODE
[QUOTE="johnnyL, post: 5813589, member: 197719"]
Completion in about 3 seconds ...

[CODE=vba]
Sub List5of35ViaArray()
'
    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
    Dim ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ThisRow                         As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 5                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 35                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ThisRow = 0                                                                                             ' Initialize row counter
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' Expected # of total combinations
'
    Application.ScreenUpdating = False                                                                      ' Turn Screen Updating off
'
    For Ball_1 = 1 To MaxWhiteBallValue - 4                                                                 ' Establish loop for 1st ball
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 3                                                  '   Establish loop for 2nd ball
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 2                                              '       Establish loop for 3rd ball
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 1                                          '           Establish loop for 4th ball
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue                                          '               Establish loop for 5th ball
                            ArraySlotCount = ArraySlotCount + 1                                             '                       Increment ArraySlotCount
'
'                           Save combination into array
                            CombinationsArray(ArraySlotCount, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
'
                            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 + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ThisRow = 0                                                                 '                           Reset row counter
                                ThisColumn = ThisColumn + ColumnIncrement                                   '                           Increment column counter
                            End If
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(1, ThisColumn), Cells(ThisRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray           ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub

Hi JohnnyL, thanks so much for the rapid response and thanks even more for code, it worked like a charm, and seriously it took like 3 seconds. And thank you for the consideration to add the code that fit the column to content. looks so neat thanks so much. Thank you so much.
[/QUOTE]

I was wondering if you wouldn't mind helping me further a bit. I wanted this list to compare all these numbers from another set of numbers. I've been using this code to compare the numbers across multiple columns, but now because the data set is so large that the first line of numbers run across multiple columns I'm a bit stuck. here is the code is use. How can I modify it so that it will be able to check all the first numbers and second numbers across all the columns. I don't know if I'm being clear in my explanation. here are some pictures of what I need. it works perfectly in the one where there are only two sets of data side by side but not with the data spread across multiple columns.

Thanks so much

 

[johnnyL]

@Samgraphics The following code will list the results down the sheet, I think that is what you were expecting.

Sub List5of35ViaArrayOneColumnRange()
'
    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
    Dim ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ResultStartRow                  As Long
    Dim ResultEndRow                    As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 5                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 35                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ResultEndRow = 0
    ResultStartRow = 1
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' Expected # of total combinations
'
    Application.ScreenUpdating = False                                                                      ' Turn Screen Updating off
'
    For Ball_1 = 1 To MaxWhiteBallValue - 4                                                                 ' Establish loop for 1st ball
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 3                                                  '   Establish loop for 2nd ball
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 2                                              '       Establish loop for 3rd ball
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 1                                          '           Establish loop for 4th ball
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue                                          '               Establish loop for 5th ball
                            ArraySlotCount = ArraySlotCount + 1                                             '                       Increment ArraySlotCount
'
'                           Save combination into array
                            CombinationsArray(ArraySlotCount, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
'
                            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
'
                            ResultEndRow = ResultEndRow + 1                                                 '                       Increment ResultEndRow
'
                            If ArraySlotCount = MaxRows Then                                                '                       If ArraySlotCount=array max slots
'                               Dump contents of CombinationsArray to the screen
                                Range(Cells(ResultStartRow, ThisColumn), Cells(ResultEndRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ResultStartRow = ResultStartRow + MaxRows
                            End If
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(ResultStartRow, ThisColumn), Cells(ResultEndRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray  ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub

 

[Samgraphics]

@Samgraphics The following code will list the results down the sheet, I think that is what you were expecting.

Sub List5of35ViaArrayOneColumnRange()
'
    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
    Dim ColumnIncrement                 As Long
    Dim CombinationCounter              As Long
    Dim ResultStartRow                  As Long
    Dim ResultEndRow                    As Long
    Dim MaxWhiteBallValue               As Long
    Dim TotalExpectedCominations        As Long
    Dim ThisColumn                      As Long
'
    Const MaxRows As Long = 65536                                                                           ' Set to maximum number of slots in Array
    Const BallsToDraw As Long = 5                                                                           ' <--- Set the number of balls to be drawn
    MaxWhiteBallValue = 35                                                                                  ' <--- Set to highest value of white ball
'
    Dim CombinationsArray(1 To MaxRows, 1 To BallsToDraw)   As Variant                                      ' Set Length and Width of array
'
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    ColumnIncrement = BallsToDraw + 1                                                                       ' Set the number of columns to advance
    CombinationCounter = 1                                                                                  ' Initialize CombinationCounter
    ResultEndRow = 0
    ResultStartRow = 1
    ThisColumn = 1                                                                                          ' Initialize 1st column to display results in
    ArraySlotCount = 0                                                                                      ' Initialize ArraySlotCount
    TotalExpectedCominations = Application.Combin(MaxWhiteBallValue, BallsToDraw)                           ' Expected # of total combinations
'
    Application.ScreenUpdating = False                                                                      ' Turn Screen Updating off
'
    For Ball_1 = 1 To MaxWhiteBallValue - 4                                                                 ' Establish loop for 1st ball
        For Ball_2 = (Ball_1 + 1) To MaxWhiteBallValue - 3                                                  '   Establish loop for 2nd ball
            For Ball_3 = (Ball_2 + 1) To MaxWhiteBallValue - 2                                              '       Establish loop for 3rd ball
                For Ball_4 = (Ball_3 + 1) To MaxWhiteBallValue - 1                                          '           Establish loop for 4th ball
                    For Ball_5 = (Ball_4 + 1) To MaxWhiteBallValue                                          '               Establish loop for 5th ball
                            ArraySlotCount = ArraySlotCount + 1                                             '                       Increment ArraySlotCount
'
'                           Save combination into array
                            CombinationsArray(ArraySlotCount, 1) = Ball_1                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 2) = Ball_2                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 3) = Ball_3                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 4) = Ball_4                                   '                       Save ball number to array
                            CombinationsArray(ArraySlotCount, 5) = Ball_5                                   '                       Save ball number to array
'
                            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
'
                            ResultEndRow = ResultEndRow + 1                                                 '                       Increment ResultEndRow
'
                            If ArraySlotCount = MaxRows Then                                                '                       If ArraySlotCount=array max slots
'                               Dump contents of CombinationsArray to the screen
                                Range(Cells(ResultStartRow, ThisColumn), Cells(ResultEndRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray
'
                                Erase CombinationsArray                                                     '                           Erase contents of array
                                ArraySlotCount = 0                                                          '                           Reset ArraySlotCount
                                ResultStartRow = ResultStartRow + MaxRows
                            End If
                    Next
                Next
            Next
        Next
    Next
'
    Range(Cells(ResultStartRow, ThisColumn), Cells(ResultEndRow, ThisColumn + BallsToDraw - 1)) = CombinationsArray  ' Dump contents of last array to the screen
    Columns.AutoFit                                                                                         ' Resize all columns to fit the data within them
    Application.StatusBar = "Completed!"                                                                    ' Let user know via status bar that program is done
'
    Application.ScreenUpdating = True                                                                       ' Turn Screen Updating back on
End Sub

Hi Johnny, Thank you again so much. you're a real life saver. The code is working perfectly and it is exactly what I wanted. Sorry for the lack of clarity in my explanations.

I was wondering if it is possible to also include the bonus numbers in this code? I did ask in my first query because I wasn't sure if it is possible. The bonus balls are drawn from a separate drum so it didn't occur to me to ask. They are from 1 - 12 and you choose two numbers.

Also, is there are way to us =COMBIN() function to calculate how much possible combinations there would be together with the first 5 balls? example =COMBIN(35,5 & 12,2) of course I know that this code is not how you write it.

Thank you so much for all your help.

 

[johnnyL]

@Samgraphics I believe that would yield over 21 million combinations.

 

[johnnyL]

= Combin(35,5) * Combin(12,2)