A while back an LP poster observed that that many computer generated pick 5 games have a tendency to repeat in pairs. I agreed with this finding and it had been on my list of things to program in a database to see if other interesting findings showed up. Or, how these pairs looked when looking for instances when 3 numbers repeat from the same prior day; or when 4 numbers repeat from the same prior day (a rare event though it has happened).  So I wrote a database script that looks at combos of 3 (below) since I already had something for looking at pairs.  Lady luck was good to me when I wrote this code last Sat 5/15; I used it to hit 3/5 four times on the LP prediction board and 5 times in real life for 17*5 or $85 (Yes I did play some of it back in the days that followed.)

Here's the basic logic (pseudo code):

SELECT Fields()

FROM [Combos of 2]

WHERE Fields() IN [Combos of 3]

AND/OR Fields() IN [Combos of 4]

And these new tables would be the basis for ad hoc querying in the database.

The script loops thru a pick 5 historical draws table and gets all 10 combos of 3 of each draw and adds it to a new table.

In this case, the history table is for California's Fantasy 5, which is known to have some anomalies, as chronicled in the LP forums.

Here's a list of the two tables and their data types:

Table: Combosof3 (new table resulting from processing)

note: idx, Num1, Num2, Num3 must all be selected as a composite primary key

Fields:

Date datetime

idx number

Num1 number

Num2 number

Num3 number

NumX text

Table: tblData (history table of draws)

Fields:

Date datetime

idx number

D1 number

D2 number

D3 number

D4 number

D5 number

Here's the code; add it to a new Access DB module (it is DAO; it will work in Access 2000/2003/2007)(Credit for

the "BubbleSort" sub-routine goes to John Walkenback aka Mr Spreadsheet and author of many Excel books, two of which I bought):

Option Compare Database
Option Explicit

Sub GenerateCombosof3()
Dim db As Database
Dim rs, rsCombo As Recordset
Dim strSQL, strSQLcombo, strDate As String
Dim Indx As Integer
Dim ArNums(1 To 3) As Integer
Dim a, ValX, AppendCount As Integer
Dim Num1, Num2, Num3 As Integer
Dim strNumX As String

strSQL = "SELECT Date, D1, D2, D3, D4, D5, Idx " & _
              "FROM tblData " & _ 
             "ORDER BY Date DESC;"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

With rs
  rs.MoveFirst
  Do
    Call DeleteQDefIfExistsX("UD1")
    Call CreateUnionQDefX(rs!Date, "UD1")
    strDate = "#" & CStr(rs!Date) & "#"
    Indx = rs!Idx
    strSQLcombo = "SELECT UD1.Drw AS Num1, T2.Drw AS Num2, T3.Drw AS Num3 " & _
                  "FROM UD1, UD1 AS T2, UD1 AS T3 " & _
                  "WHERE (((UD1.Drw)<>[T2].[Drw] And (UD1.Drw)<>[T3].[Drw]) " & _
                  "AND ((T2.Drw)<>[UD1].[Drw] And (T2.Drw)<>[T3].[Drw]) " & _
                  "AND ((T3.Drw)<>[UD1].[Drw] And (T3.Drw)<>[T2].[Drw])) " & _
                  "ORDER BY UD1.Drw, T2.Drw, T3.Drw;"
   
    Set rsCombo = db.OpenRecordset(strSQLcombo)
    With rsCombo
    rsCombo.MoveFirst
    Do
       Num1 = rsCombo!Num1
       Num2 = rsCombo!Num2
       Num3 = rsCombo!Num3
       strNumX = CStr(rsCombo!Num1) & "-" & CStr(rsCombo!Num2) & "-" & CStr(rsCombo!Num3)
     
       For a = 1 To 3
           ValX = Switch(a = 1, Num1, a = 2, Num2, a = 3, Num3)
           ArNums(a) = ValX
       Next
       a = a - 1
       Call BubbleSort(ArNums())
       Num1 = ArNums(a - 2)
       Num2 = ArNums(a - 1)
       Num3 = ArNums(a)
                     
       DoCmd.SetWarnings False
       DoCmd.RunSQL "INSERT INTO Combosof3 ( [Date], idx, Num1, Num2, Num3, NumX ) " & _
                     "SELECT " & strDate & ", " & Indx & ", " & Num1 & ", " & Num2 & ", " & Num3 & ", '" & strNumX & "';"
       DoCmd.SetWarnings True
   
        rsCombo.MoveNext
     Loop Until rsCombo.EOF
    End With
     rs.MoveNext
  Loop Until rs.EOF

End With

Set rs = Nothing
MsgBox "done"

End Sub

Function CreateUnionQDefX(dteIn As Date, qdefName As String)
Dim db As Database, rs As Recordset, qdef1 As QueryDef, qdef2 As QueryDef, sDate As String

sDate = "#" & CStr(dteIn) & "#"
Set db = CurrentDb
Set qdef1 = db.CreateQueryDef(qdefName, "SELECT tblData.Idx, tblData.Date, tblData.D1 AS Drw " & _
"FROM tblData " & _
"WHERE (((tblData.Date) = " & sDate & ")) " & _
"Union ALL " & _
"SELECT tblData.Idx, tblData.Date, tblData.D2 " & _
"FROM tblData " & _
"WHERE (((tblData.Date) = " & sDate & ")) " & _
"Union ALL " & _
"SELECT tblData.Idx, tblData.Date, tblData.D3 " & _
"FROM tblData " & _
" WHERE (((tblData.Date) = " & sDate & ")) " & _
"Union ALL " & _
" SELECT tblData.Idx, tblData.Date, tblData.D4 " & _
"FROM tblData " & _
"WHERE (((tblData.Date) = " & sDate & ")) " & _
"UNION ALL " & _
"SELECT tblData.Idx, tblData.Date, tblData.D5 " & _
"FROM tblData " & _
"WHERE (((tblData.Date)=" & sDate & "));")

End Function

Function DeleteQDefIfExistsX(strIn As String)
Dim db As Database, rs As Recordset, qdf As QueryDef, qCt As Integer, x As Integer

Set db = CurrentDb
For Each qdf In CurrentDb.QueryDefs
   'Debug.Print qdf.Name
   If qdf.Name = strIn Then
      CurrentDb.QueryDefs.Delete (strIn)
      Exit For
   End If
Next
End Function

Sub BubbleSort(list() As Integer)
Dim First As Integer, Last As Integer, i As Integer, j As Integer, temp
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
  For j = i + 1 To Last
    If list(i) > list(j) Then
       temp = list(j)
       list(j) = list(i)
       list(i) = temp
    End If
  Next j
Next i

End Sub