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!

 

[Samgraphics]

Hi Johny thank you so much for your help. I'll be sure to remember you if I ever do win. Thanks so much.

I've been looking for this,
As Baymax from Big Hero 6 might say, "If you are satisfied with your care, Please select the check mark to the right of the post that solved your problem."
I don't see the check mark.

 

[johnnyL]

For the most part, that option is reserved for the person that started the thread. If you want to see that option, you will have to start a new thread,

 

[ayla]

אני רוצה לסנן את הרשימה מאוחר יותר לפי פונקציות נוספות אבל אני לא מכיר את אקסל תודה רבה על ההסבר הברור איילה

 

[ayla]

I would like to filter the list later by additional functions but I do not know Excel Thank you very much for the clear explanation Doe

 

[BSALV]

how/what do you want to filter ?

 

[ayla]

Download a sequence of numbers 5 of which have the same or even or odd difference
If you can help me with this I would be very happy .............

 

[ayla]

For example the whole sequence of numbers from: 1-2-3-4-5-6 to 1-2-3-4-5-44
And also: 2-6-18-22-36-37 to 2-6-18-22-36-44Because it has 5 even numbers and
1-7-19-35-37-38up 1-7-19-35-37-44Because it has 5 odd numbers
The sequence decreases because it has 5 numbers with the same difference (1 + 1 = 2,2 + 1 = 3,3 + 1 = 4,4 + 1 = 5)

 

[BSALV]

3 macros
- all = all 7M combinations
- OneOdd = 5 even and 1 odd number
- OneEven = 5 odd and 1 even number
Combinations.xlsb

 

[ayla]

I was unable to open the Excel spreadsheet you uploaded,
If I go through all the data again it will take full time (I have about 10 more types of filtering) and if I hit the macros from the macro of all the numbers it will not be able to return value so I do not know what to do ....
Thank you so much for all the help

 

[BSALV]

here are the macros

Public ArrComb, Arr100K, ptr

Private Sub Leegmaken()
     ActiveSheet.Cells.ClearContents
End Sub

Sub All()
     t = Timer
     MyCombinations 44, 6, 0
     t0 = Timer
     Dump
     MsgBox "Total time : " & Format(Timer - t, "0.0\s") & vbLf & "Collecting : " & Format(t0 - t, "0.00")
End Sub

Sub OneOdd()
     t = Timer
     MyCombinations 44, 6, 1
     t0 = Timer
     Dump
     MsgBox "Total time : " & Format(Timer - t, "0.0\s") & vbLf & "Collecting : " & Format(t0 - t, "0.00")
End Sub

Sub OneEven()
     t = Timer
     MyCombinations 44, 6, 2
     t0 = Timer
     Dump
     MsgBox "Total time : " & Format(Timer - t, "0.0\s") & vbLf & "Collecting : " & Format(t0 - t, "0.00")
End Sub

Private Sub Dump()
     Application.ScreenUpdating = False
     ActiveSheet.Cells.ClearContents
     If ptr > Rows.Count Then Range("D1").Resize(UBound(Arr100K), UBound(Arr100K, 2)).Value = Arr100K
     Range("A1").Resize(Application.Min(Rows.Count, UBound(ArrComb))).Value = ArrComb
     Range("A1:Z1").EntireColumn.AutoFit
     Application.ScreenUpdating = True
     DoEvents
End Sub

Sub MyCombinations(N, K, Fl)
     Dim iCombinations As Long, t, Aux, r As Long, i, j

     ptr = 0
     iCombinations = WorksheetFunction.Combin(N, K)      'possible combinaties
     Aux = Evaluate("=column(offset(a1,,,," & K & "))")    'start, 1st combination
     ReDim ArrComb(1 To iCombinations, 1 To 1)
     ReDim Arr100K(1 To 100000, 1 To iCombinations \ 100000 + 1)

     For r = 1 To iCombinations                                 'alle combinaties doorlopen
          If r Mod 500000 = 0 Then
               Application.StatusBar = Format(r, "0,000"): DoEvents
          End If

          Select Case Fl
               Case 0: b = True
               Case 1: b = F_OneOdd(Aux)
               Case 2: b = F_OneEven(Aux)
          End Select
          If b Then
               ptr = ptr + 1
               ArrComb(ptr, 1) = Join(Aux, "-")
               Arr100K((ptr - 1) Mod 100000 + 1, (ptr - 1) \ 100000 + 1) = Join(Aux, "-")    'specially because combinations > rows.count
          End If

          Aux(K) = Aux(K) + 1
          If Aux(K) > N Then                  'laatste voorbij target !
               For i = K - 1 To 1 Step -1            'voorgaande kolommen aflopen
                    If Aux(i) < N - (K - i) Then     'tot aan die kolom die nog 1 mag opgehoogd worden
                         Aux(i) = Aux(i) + 1         'die kolom 1 ophogen
                         For j = i + 1 To K         'alle volgende kolommen
                              Aux(j) = Aux(j - 1) + 1     'gelijk aan de vorige kolom +1
                         Next
                         Exit For                          'wip uit de loop
                    End If
               Next
          End If

     Next
     Application.StatusBar = ""
End Sub

Function F_OneOdd(arr)
     Dim i, j
     For i = LBound(arr) To UBound(arr)
          j = j + (arr(i) Mod 2)
          If j > 1 Then Exit For
     Next
     F_OneOdd = (j = 1)
End Function

Function F_OneEven(arr)
     Dim i, j
     For i = LBound(arr) To UBound(arr)
          j = j - (arr(i) Mod 2 = 0)
          If j > 1 Then Exit For
     Next
     F_OneEven = (j = 1)
End Function