Delete Duplicate Records based on criteria (1 Viewer)

Status
Not open for further replies.

ajetrumpet

Banned
Local time
Today, 08:00
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:
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
The attachment shows the result in this example.
 

Attachments

  • MailList Example.zip
    34.6 KB · Views: 505
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom