Checking for duplicates

[Gordon]

I am using the code below in the before update of my form to check for
duplicate records (using the criteria surname/postcode/issue date less
than 2 years.


strSQL = "SELECT DISTINCTROW tblCompTicketIssues.fldSurname,
tblCompTicketIssues.fldPostCode, "
strSQL = strSQL & "FROM tblCompTicketIssues WHERE DateDiff(" & """d"""
& ",[fldIssueDate],Now()) < 730 AND "
strSQL = strSQL & "(((tblCompTicketIssues.fldSurname) In (SELECT
[fldSurname] FROM [tblCompTicketIssues] "
strSQL = strSQL & "As Tmp GROUP BY [fldSurname],[fldPostCode] HAVING
Count(*)>1 And [fldPostCode] = [tblCompTicketIssues].
[fldPostCode])))"

Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
With rst
' Loop through the records, creating a string of names and ID numbers

Do While Not .EOF
sOut = sOut & " " & !fldSurname & " " & !fldPostCode & " - Issue
ID # " & !fldContactID & vbCrLf
..MoveNext
lngDupes = lngDupes + 1
If lngDupes > conMaxDupes And Not .EOF Then
sOut = sOut & " and others." & vbCrLf

The code works OK, giving the user the opportunity on input/update to
accept a duplicate. The problem is that after the update of any
record, the message box throws up all the duplicates, even ones that
have been previously accepted. How can I modify the code so that it
just checks if the current record is a duplicate of any others.

Gordon

 

[Arvin Meyer MVP]

There is no Message Box code in the example you gave.

 

[Mike Painter]

I am using the code below in the before update of my form to check for
duplicate records (using the criteria surname/postcode/issue date less
than 2 years.


strSQL = "SELECT DISTINCTROW tblCompTicketIssues.fldSurname,
tblCompTicketIssues.fldPostCode, "
strSQL = strSQL & "FROM tblCompTicketIssues WHERE DateDiff(" & """d"""
& ",[fldIssueDate],Now()) < 730 AND "
strSQL = strSQL & "(((tblCompTicketIssues.fldSurname) In (SELECT
[fldSurname] FROM [tblCompTicketIssues] "
strSQL = strSQL & "As Tmp GROUP BY [fldSurname],[fldPostCode] HAVING
Count(*)>1 And [fldPostCode] = [tblCompTicketIssues].
[fldPostCode])))"

Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
With rst
' Loop through the records, creating a string of names and ID numbers

Do While Not .EOF
sOut = sOut & " " & !fldSurname & " " & !fldPostCode & " - Issue
ID # " & !fldContactID & vbCrLf
.MoveNext
lngDupes = lngDupes + 1
If lngDupes > conMaxDupes And Not .EOF Then
sOut = sOut & " and others." & vbCrLf

The code works OK, giving the user the opportunity on input/update to
accept a duplicate. The problem is that after the update of any
record, the message box throws up all the duplicates, even ones that
have been previously accepted. How can I modify the code so that it
just checks if the current record is a duplicate of any others.

Using FindFirst to locate the first dup, if it exists would be one way.
If not you will need to exit your loop at some point.
Without having all the code thre is no easy way to say where.

 

[Gordon]

I am using the code below in the before update of my form to check for
duplicate records (using the criteria surname/postcode/issue date less
than 2 years.

strSQL = "SELECT DISTINCTROW tblCompTicketIssues.fldSurname,
tblCompTicketIssues.fldPostCode, "
strSQL = strSQL & "FROM tblCompTicketIssues WHERE DateDiff(" & """d"""
& ",[fldIssueDate],Now()) < 730 AND "
strSQL = strSQL & "(((tblCompTicketIssues.fldSurname) In (SELECT
[fldSurname] FROM [tblCompTicketIssues] "
strSQL = strSQL & "As Tmp GROUP BY [fldSurname],[fldPostCode] HAVING
Count(*)>1  And [fldPostCode] = [tblCompTicketIssues].
[fldPostCode])))"

Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
With rst
' Loop through the records, creating a string of names and ID numbers

 Do While Not .EOF
sOut = sOut & "    " & !fldSurname & " " & !fldPostCode & "  - Issue
ID # " & !fldContactID & vbCrLf
.MoveNext
lngDupes = lngDupes + 1
If lngDupes > conMaxDupes And Not .EOF Then
sOut = sOut & "    and others." & vbCrLf

The code works OK, giving the user the opportunity on input/update to
accept a duplicate.  The problem is that after the update of any
record, the message box throws up all the duplicates, even ones that
have been previously accepted.  How can I modify the code so that it
just checks if the current record is a duplicate of any others.

Using FindFirst to locate the first dup, if it exists would be one way.
If not you will need to exit your loop at some point.
Without having all the code thre is no easy way to say where.- Hide quoted text -

- Show quoted text -

Sorry for the delay in responding - been away for a few days. Here
is the expaded code with the details of the messge box:

strSQL = "SELECT DISTINCTROW tblCompTicketIssues.fldSurname,
tblCompTicketIssues.fldPostCode, tblCompTicketIssues.fldContactID, "
strSQL = strSQL & "tblCompTicketIssues.fldInitials,
tblCompTicketIssues.fldIssueDate "
strSQL = strSQL & "FROM tblCompTicketIssues WHERE DateDiff(" & """d"""
& ",[fldIssueDate],Now()) < 730 AND "
strSQL = strSQL & "(((tblCompTicketIssues.fldSurname) In (SELECT
[fldSurname] FROM [tblCompTicketIssues] "
strSQL = strSQL & "As Tmp GROUP BY [fldSurname],[fldPostCode] HAVING
Count(*)>1 And [fldPostCode] = [tblCompTicketIssues].
[fldPostCode])))"
strSQL = strSQL & "ORDER BY tblCompTicketIssues.fldSurname,
tblCompTicketIssues.fldPostCode;"

Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL)
With rst
' Loop through the records, creating a string of names and ID numbers

Do While Not .EOF
sOut = sOut & " " & !fldSurname & " " & !fldPostCode & " - Issue
ID # " & !fldContactID & vbCrLf
..MoveNext
lngDupes = lngDupes + 1
If lngDupes > conMaxDupes And Not .EOF Then
sOut = sOut & " and others." & vbCrLf

Exit Do
End If
Loop
End With
rst.Close
Set rst = Nothing
Set db = Nothing

End If

' If possible duplicates are found, ask the user what to do.

If lngDupes > 0 Then
sOut = "Possible duplicate" & IIf(lngDupes = 1, ":", "s:") &
vbCrLf & vbCrLf & sOut & vbCrLf & vbCrLf & "Continue anyway?"
If MsgBox(sOut, vbQuestion + vbYesNo + vbDefaultButton2, "Are you
sure?") <> vbYes Then
Cancel = True
Me.Undo
End If

End If

Hope you can still come up with a solution as to why this code throws
up all dupes, not just a possible dupe for the current record.

Thanks

Gordon