Lottery combinations

[keith1]

Hi
I am after the code to generate all the combinations of the UK lottery 6/49. Will excel hold this much data as it is nearly 14 mil combos.
Thanks

 

[Ruddles]

I would like to generate all combinations and store them. Then I want to run a few tests to eliminate unlikely combinations based on previous draw history, such as all odds, or 6 numbers in a group of ten amongst others. If you could post the code for this, that would really help. I am a novice with access and vba, so any help is greatly appreciated. Thanks

You're surely not going to tell me that you believe that any combination is more or less likely to occur than any other combination?

 

[keith1]

No, not at all, but I want to see how many combinations it can be whittled down to based on over 1600 previous draws which when analysed show higher probabilities of certain sequences occuring than others. For instance all odd numbers, or all even numbers could be ruled out. This is not to say that it will not happen but the probability is more in favour of it not happening BASED on previous history.

 

[Ruddles]

A draw of ALL SIX ODDS is less likely to occur than a draw of NOT(ALL SIX ODDS) but only because there are fewer members in the set ALL SIX ODDS than there are members in the set NOT(ALL SIX ODDS).

However each member of the set ALL SIX ODDS is just as likely to occur as each member of the set NOT(ALL SIX ODDS) - and that is what you need to be looking at.

Any approach which regards some combinations as less or more likely to occur than any others is flawed. Your maths tutor will no doubt be able to spend as much time as is necessary to explain this to you.

I'll post the code to generate the table of combinations but I won't give you any guidance which sends you down the wrong path.

Incidentally, what do you think the odds are of getting six odd numbers in a single draw?

 

[Ruddles]

Start MS Access, click Create > Macro > Module, and paste this code in place of whatever is already in the newly-created module. Run the code. A new table will appear called tblCombinations.

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub Generate_6ex49()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim dbData As DAO.Database
  Dim rsData As DAO.Recordset
  Dim p1 As Integer
  Dim p2 As Integer
  Dim p3 As Integer
  Dim p4 As Integer
  Dim p5 As Integer
  Dim p6 As Integer
  Dim dtStart As Date
  
  On Error Resume Next
  DoCmd.SetWarnings False
  DoCmd.RunSQL ("DROP TABLE tblCombinations;")
  DoCmd.SetWarnings True
  On Error GoTo 0
  DoCmd.RunSQL ("CREATE TABLE tblCombinations ( " _
       & "[Ball1] Integer, " _
       & "[Ball2] Integer, " _
       & "[Ball3] Integer, " _
       & "[Ball4] Integer, " _
       & "[Ball5] Integer, " _
       & "[Ball6] Integer[COLOR=red],[/COLOR] " _
[COLOR=red]       & "[Frequency] Long " _
[/COLOR]       & ");")
  
  Set dbData = CurrentDb()
  Set rsData = dbData.OpenRecordset("tblCombinations")
  
  dtStart = Now()
  
  For p1 = 1 To 43
    For p2 = p1 + 1 To 45
      For p3 = p2 + 1 To 46
        For p4 = p3 + 1 To 47
          For p5 = p4 + 1 To 48
            For p6 = p5 + 1 To 49
              With rsData
                .AddNew
                !Ball1 = p1
                !Ball2 = p2
                !Ball3 = p3
                !Ball4 = p4
                !Ball5 = p5
                !Ball6 = p6
                !Frequency = 0
                .Update
              End With
            Next p6
          Next p5
        Next p4
      Next p3
    Next p2
  Next p1
  
  MsgBox Format(rsData.RecordCount, "#,###") & " combinations" & Space(10) _
       & vbCrLf & vbCrLf _
       & "Run time: " & Format(Now() - dtStart, "hh:nn:ss"), _
       vbOKOnly + vbInformation
  
  rsData.Close[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]End Sub[/FONT]

The table has an additional field called Frequency which you may want to use later. If you don't want this additional field, delete the code in red before running it.

 

[Ruddles]

Oops, that first loop should have been:-

[FONT=Fixedsys]  For p1 = 1 To 44[/FONT]

Sorry!

 

[keith1]

Thanks for the code, it worked reaaly fast. Do you know of a quick way I could export the data into Excel. I worked out I would need over approx 215 sheets based on 65000 rows to a sheet. Is there some way of populating multiple sheets in one go.

Using all straight odds or straight evens in a 6 ball draw with no bias towards any ball would give a total of 311696 combinations, which is about 0.022 chance of happening. Two draws give a 0.0005 of chance of occuring in both draws and so on.

 

[keith1]

Oops, there are 1,048,576 rows in Excel 2010 so approx 14 sheets needed.

 

[Ruddles]

Do you know of a quick way I could export the data into Excel... Is there some way of populating multiple sheets in one go.

I don't have anything off-the-shelf which will do that - perhaps someone else is reading this and can help?

I suppose you could argue that this is a different requirement to your original one, so if no-one else responds you could validly start a new thread and that might produce a helpful response.

I'm at work at the moment but I'll give it some thought when I get home if no-one else comes up with a solution before then.

 

[Ruddles]

Rather than try to convert that Access table to fourteen worksheets, I've rewritten the code so that it creates the worksheets and generates the 13.98m combinations required to fill them.

Start a new workbook with just a Sheet1 in it, then paste the code into a new standard module. Sheet1 is referenced once in the code: change that statement if you want to call it something else.

The sheets containing the combinations will be called Part001, Part002, etc, up to Part014. The root part of the name is referenced once at the start of the code: change this if you want the sheets called something else.

Each worksheet will contain exactly 1,000,000 combinations. This figure is defined at the start of the code: change this if you want fewer combinations in each sheet. I'm fairly sure that using a smaller figure will result in a quicker run time.

The Partxxx sheets are deleted when the code starts, if they exist. If you just want to delete the sheets, run the code and reply "No" to the prompt.

Sorry if the code's a bit messy but I merely bolted yesterday's code from the Access database on to some multiple-sheet-creation code I had knocking about from way back.

[FONT=Courier New][SIZE=1]Option Explicit[/SIZE][/FONT]
 
[FONT=Courier New][SIZE=1]Public Sub Generate6ex49()[/SIZE][/FONT]
 
[SIZE=1][FONT=Courier New]Const MainSheet As String = "[COLOR=red][B]Sheet1[/B][/COLOR]"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Const SheetPrefix As String = "[COLOR=red][B]Part[/B][/COLOR]"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Const SplitPoint As Long = [COLOR=red][B]1000000[/B][/COLOR][/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Const HighBall As Integer = 49[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Dim iPtr As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim sFileName As String[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim SheetNumber As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim iRow As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim iRec As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim iLastRow As Long[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim ws As Worksheet[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim sMessage As String[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim sTime As Date[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Dim p1 As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim p2 As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim p3 As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim p4 As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim p5 As Integer[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Dim p6 As Integer[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]For Each ws In ThisWorkbook.Worksheets[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]If Left(ws.Name, Len(SheetPrefix)) = SheetPrefix Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  Application.DisplayAlerts = False[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  On Error Resume Next[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  ws.Delete[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  On Error GoTo 0[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  Application.DisplayAlerts = True[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]End If[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next ws[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Columns("A:B").ClearContents[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]sMessage = vbCrLf & "Workbook reset. Proceed to create combination records?" _[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]       & Space(10) & vbCrLf & vbCrLf _[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]       & "Warning: this will take several minutes!"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]If MsgBox(sMessage, vbYesNo + vbQuestion) = vbNo Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Exit Sub[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]End If[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Range("A1:B1").Font.Bold = True[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Range("A1") = "Worksheet"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Range("B1") = "Records"[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]sTime = Now()[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]SheetNumber = 0[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]iRow = SplitPoint[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]iRec = 0[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]For p1 = 1 To HighBall - 5[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]For p2 = p1 + 1 To HighBall - 4[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  For p3 = p2 + 1 To HighBall - 3[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]    For p4 = p3 + 1 To HighBall - 2[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]      For p5 = p4 + 1 To HighBall - 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]        For p6 = p5 + 1 To HighBall[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          iRec = iRec + 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          iRow = iRow + 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          If iRow > SplitPoint Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            If SheetNumber > 0 Then[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]              iLastRow = Sheets(MainSheet).Cells(Rows.Count, 1).End(xlUp).Row[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]              Sheets(MainSheet).Cells(iLastRow, 2) = iRow - 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            End If[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            SheetNumber = SheetNumber + 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            Sheets.Add(After:=Sheets(Sheets.Count)).Name = SheetPrefix & Right("00" & CStr(SheetNumber), 3)[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            Sheets(MainSheet).Activate[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            iLastRow = Sheets(MainSheet).Cells(Rows.Count, 1).End(xlUp).Row[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            Set ws = Sheets(SheetPrefix & Right("00" & CStr(SheetNumber), 3))[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            Sheets(MainSheet).Cells(iLastRow + 1, 1) = ws.Name[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]            iRow = 1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          End If[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 1) = p1[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 2) = p2[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 3) = p3[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 4) = p4[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 5) = p5[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          ws.Cells(iRow, 6) = p6[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]          DoEvents[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]        Next p6[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]      Next p5[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]    Next p4[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]  Next p3[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next p2[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Next p1[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Cells(iLastRow + 1, 2) = iRow[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Cells(iLastRow + 2, 1) = "Total"[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Cells(iLastRow + 2, 2) = iRec[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Columns("A:B").EntireColumn.AutoFit[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]Sheets(MainSheet).Range("A1").Select[/FONT][/SIZE]
 
[SIZE=1][FONT=Courier New]MsgBox vbCrLf & Format(iRec, "#,###") & " records created" & Space(10) & vbCrLf & vbCrLf _[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]   & CStr(SheetNumber) & " worksheets created" & vbCrLf & vbCrLf _[/FONT][/SIZE]
[SIZE=1][FONT=Courier New]   & "Run time: " & Format(Now() - sTime, "hh:nn:ss"), vbOKOnly + vbInformation[/FONT][/SIZE]
 
[FONT=Courier New][SIZE=1]End Sub[/SIZE][/FONT]

You might want to try it with SplitPoint set to a lower number for the first run through, just to satisfy yourself that it's working. As I do a DoEvents every loop, you can still navigate your way around the workbook whilst the code's running so you can actually watch the combinations being added. Remove the DoEvents to speed the code up slightly.

 

[keith1]

Hi Ruddles

I entered the code and left it for an hour and it has worked perfect.

Thank you very much for taking the time out to do this, it has saved me a lot of work.

I can now have a play around with the numbers and see if I can figure anything out, either way it is keeping me amused.

Thanks again for your invaluable help.