Comment #3

LottoMining — Sun, 30 May 2010 20:19:39 GMT

<br />Docmd.SetWarnings False<br /><br />enables the append statement to continue after encountering duplicate records from the query that feeds it, otherwise an error message would be generated that would end the sub routine unless some error handling (exception handling) had been written. It is an implicit "brute force" method, if I may toss in this literal contradiction in terms. (Recall that the combosof4 table should have a composite primary key to enforce uniqueness... [ More ]

Comment #2

LottoMining — Tue, 25 May 2010 16:01:16 GMT

The BubbleSort sub can work as is in an Excel module since no piece of its syntax is tied to Excel's object model. The other subs and functions would have to be re-written if you wanted to call it from Excel and you'd have to set a VB Reference to the Access library so Excel's VBA IDE could understand the Access syntax. The code would need to create an object variable, which would be an instance of Access and then you could "call" (i.e. use) its properties and methods.... [ More ]

Comment #1

CARBOB — Mon, 24 May 2010 12:41:08 GMT

I don't have or use Access, will this work in Excel??

Original Blog Entry: Access database code to generate combos of 3 from Pick 5 table

LottoMining — Mon, 24 May 2010 00:43:45 GMT

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

... [ More ]