ajetrumpet
Banned
- Local time
- Today, 03:38
- Joined
- Jun 22, 2007
- Messages
- 5,638
Below is some code that will loop through a recordset and delete specific records based on the criteria that you write in the code. This particular function of mine searches for duplicate email addresses, and only deletes a record if the email address is the same, and the times are less than 10 minutes apart from each other. I don't believe there is an option in the query wizard to delete duplicates with this type of specific need, so I'm posting this code here for use. The section in red is what can be changed to meet your specific needs:
The attachment shows the result in this example.
Code:
Function DeleteDupTimes()
Dim rs1 As Recordset, rs2 As Recordset
Dim mydate As Date, myemail As String, x As Long
DoCmd.DeleteObject acTable, "clicks"
DoCmd.DeleteObject acTable, "opens"
DoCmd.CopyObject , "clicks", acTable, "clicksOLD"
DoCmd.CopyObject , "opens", acTable, "opensOLD"
RefreshDatabaseWindow
Set rs1 = CurrentDb.OpenRecordset("opens", dbOpenDynaset)
Set rs2 = CurrentDb.OpenRecordset("clicks", dbOpenDynaset)
x = 0
rs1.MoveFirst [COLOR="Green"]'MOVE TO THE FIRST RECORD[/COLOR]
With rs1[COLOR="Green"] 'OPENS TABLE[/COLOR]
Do Until .EOF
myemail = !email
mydate = !Date
.MoveNext
Do Until .EOF[COLOR="SeaGreen"][COLOR="Green"] 'CHECK ALL RECORDS FOR THE SAME EMAIL AND
TIMES WITHIN 10 MINUTES OF THE ORIGINAL RECORD[/COLOR][/COLOR]
[COLOR="Red"] If (!email = myemail) And _
(DateDiff("n", mydate, !Date) > -10 And _
DateDiff("n", mydate, !Date) < 10) Then[/COLOR]
.Delete [COLOR="Green"]'DELETE THE DUPLICATE RECORD IF THE TWO
TIMES ARE LESS THAN 10 MINUTES APART[/COLOR]
End If
.MoveNext
Loop
.MoveFirst
x = x + 1
.Move x [COLOR="Green"]'MOVE TO THE NEXT RECORD IN LINE FOR CHECKING[/COLOR]
Loop
End With
rs1.Close
Set rs = Nothing
x = 0
rs2.MoveFirst[COLOR="Green"] 'MOVE TO THE FIRST RECORD[/COLOR]
With rs2 [COLOR="Green"]'CLICKS TABLE[/COLOR]
Do Until .EOF
myemail = !email
mydate = !Date
.MoveNext
Do Until .EOF [COLOR="Green"]'CHECK ALL RECORDS FOR THE SAME EMAIL AND
TIMES WITHIN 10 MINUTES OF THE ORIGINAL RECORD[/COLOR]
[COLOR="Red"] If (!email = myemail) And _
(DateDiff("n", mydate, !Date) > -10 And _
DateDiff("n", mydate, !Date) < 10) Then[/COLOR]
.Delete[COLOR="Green"] 'DELETE THE DUPLICATE RECORD IF THE TWO
TIMES ARE LESS THAN 10 MINUTES APART[/COLOR]
End If
.MoveNext
Loop
.MoveFirst
x = x + 1
.Move x [COLOR="Green"]'MOVE TO THE NEXT RECORD IN LINE FOR CHECKING[/COLOR]
Loop
End With
rs2.Close
Set rs2 = Nothing
End Function