CompareDB

Private Sub Form_Load()
Dim db As Database
Dim tb As TableDef
Dim fld As Field
Dim indx As Index

Dim rs As Recordset
Dim ds As Recordset
Dim strSQL As String
Dim intX As Integer
Dim StartDate As Date

Const DBName As String = "\john.mdb"

If Dir(App.Path & DBName) <> "" Then Kill App.Path & DBName
'make database

Set db = CreateDatabase(App.Path & DBName, dbLangGeneral)
'make a table

Set tb = db.CreateTableDef("dates")
'make two date-fields

Set fld = tb.CreateField("dateone", dbDate)
tb.Fields.Append fld
Set fld = tb.CreateField("datetwo", dbDate)
tb.Fields.Append fld
db.TableDefs.Append tb
Set db = OpenDatabase(App.Path & DBName)
Set rs = db.OpenRecordset("dates")

'fill field 1

StartDate = Format(Now, "Short Date")
For intX = 1 To 5000
Randomize
StartDate = DateAdd("m", CInt((12 * Rnd) + 1), StartDate)
StartDate = DateAdd("d", CInt((30 * Rnd) + 1), StartDate)
With rs
.AddNew
.Fields(0).Value = StartDate
.Update
End With
Next intX

'fill field 2

rs.MoveFirst
StartDate = Format("01-01-1998", "Short Date")
Do While Not rs.EOF
Randomize
StartDate = DateAdd("m", CInt((12 * Rnd) + 1), StartDate)
StartDate = DateAdd("d", CInt((30 * Rnd) + 1), StartDate)
With rs
.Edit
.Fields(1).Value = StartDate
.Update
End With
rs.MoveNext
Loop
rs.MoveFirst
Do While Not rs.EOF
intX = 0
strSQL = "SELECT dates.dateone, dates.datetwo From dates _
WHERE (((dates.datetwo)>#" & rs.Fields(0).Value & "#));"
Set ds = db.OpenRecordset(strSQL)
If Not (ds.BOF And ds.EOF) Then
Do While Not ds.EOF
intX = intX + 1
ds.MoveNext
Loop
MsgBox " found " & CStr(intX) & " times greater"
End If
ds.Close
rs.MoveNext
Loop
rs.Close
db.Close

End Sub