R
riccifs
Hi to everyone,
I know how to check for duplicates entries for a single field or for a
pair of fields, but now I am realizing to have a different problem.
Image that I registered in a filed of my form a person named John
McDonald and a couple of mouths later I do another registration but
this time, for a my true typing mistake, I write John McDonold with
the "o" instead the "a" in McDonald. For the db, of course, They are
two different persons and leave my insert both of them.
The question is: How do I prevent something like that to happen? I
mean is it possible to make a string compare and for example, if at
least the 80% of the words in the strings are the same I will receive
a Msgbox that alert me to a possible duplicate record, and leave to me
to decide what to do.
At moment the code I am using is the one that came from Steve Sanford.
It works great but I'd like to implement it in the way I described
above.
You can get the entire discussion at this link:
http://groups.google.it/group/micro...a744c767?lnk=gst&q=duplicate#df71c244a744c767
'-------------------------------
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = DuplicateCheck
End Sub
Private Sub tbDOB_Exit(Cancel As Integer)
Cancel = DuplicateCheck
End Sub
'-------------------------------
Here is the function to check for dups:
'------beg code-------------------------
Function DuplicateCheck() As Boolean
Dim SID As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Dim mPrompt As String
Dim mButtons, mTitle, Response
'check if change to form data
If Not Me.Dirty Then
Exit Function
End If
Set rsc = Me.RecordsetClone
'for message box
mPrompt = "Warning: Possible Duplicate Record" & vbCr & vbCr
mPrompt = mPrompt & "Do you want to continue to add this record?" &
vbCr
& vbCr
mPrompt = mPrompt & "Select YES to add the record" & vbCr & vbCr
mPrompt = mPrompt & "Select NO to be taken to the record."
mButtons = vbYesNo + vbCritical + vbDefaultButton2
mTitle = "Duplicate Information"
'check that all criteria are entered
If IsNull(Me.tbLastName) Then
MsgBox "Last name is required!!", vbOKOnly + vbExclamation
DuplicateCheck = True
Me.tbLastName.SetFocus
Exit Function
End If
If IsNull(Me.tbFirstName) Then
MsgBox "First name is required!!", vbOKOnly + vbExclamation
DuplicateCheck = True
Me.tbFirstName.SetFocus
Exit Function
End If
If IsNull(Me.tbDOB) Then
MsgBox "Date of Birth is required!!", vbOKOnly + vbExclamation
'
DuplicateCheck = True
Me.tbDOB.SetFocus
Exit Function
End If
stLinkCriteria = "[strLastName]= '" & Me.tbLastName & "'"
stLinkCriteria = stLinkCriteria & " And [strFirstName]= '" &
Me.tbFirstName & "'"
stLinkCriteria = stLinkCriteria & " And [dtmDOB] = #" & Me.tbDOB &
"# "
rsc.FindFirst stLinkCriteria
'next 3 lines are for testing
' Debug.Print rsc!strLastName
' Debug.Print rsc!strFirstName
' Debug.Print rsc!dtmDOB
'always check the NoMatch property after a find
' rsc.NoMatch = TRUE means no duplicates
' rsc.NoMatch = FALSE means there are duplicates
' if rsc.NoMatch = FALSE, then NOT rsc.NoMatch is TRUE
' I hate negative logic!!!
'********changes here*************
If Not rsc.NoMatch Then
'possible duplicate record found
'ask if they want to goto the record or continue to add record
Response = MsgBox(mPrompt, mButtons, mTitle)
If Response = vbNo Then ' User chose No
'undo entries and goto record
Me.Undo
Me.Bookmark = rsc.Bookmark
Me.tbLastName.SetFocus
End If
End If
'*********************************
DuplicateCheck = False
'clean up
rsc.Close
Set rsc = Nothing
End Function
'------end code-------------------------
Hope someone will help me, may be Steve Sanford....
Many thanks to everyone,
Stefano.
I know how to check for duplicates entries for a single field or for a
pair of fields, but now I am realizing to have a different problem.
Image that I registered in a filed of my form a person named John
McDonald and a couple of mouths later I do another registration but
this time, for a my true typing mistake, I write John McDonold with
the "o" instead the "a" in McDonald. For the db, of course, They are
two different persons and leave my insert both of them.
The question is: How do I prevent something like that to happen? I
mean is it possible to make a string compare and for example, if at
least the 80% of the words in the strings are the same I will receive
a Msgbox that alert me to a possible duplicate record, and leave to me
to decide what to do.
At moment the code I am using is the one that came from Steve Sanford.
It works great but I'd like to implement it in the way I described
above.
You can get the entire discussion at this link:
http://groups.google.it/group/micro...a744c767?lnk=gst&q=duplicate#df71c244a744c767
'-------------------------------
Private Sub Form_BeforeUpdate(Cancel As Integer)
Cancel = DuplicateCheck
End Sub
Private Sub tbDOB_Exit(Cancel As Integer)
Cancel = DuplicateCheck
End Sub
'-------------------------------
Here is the function to check for dups:
'------beg code-------------------------
Function DuplicateCheck() As Boolean
Dim SID As String
Dim stLinkCriteria As String
Dim rsc As DAO.Recordset
Dim mPrompt As String
Dim mButtons, mTitle, Response
'check if change to form data
If Not Me.Dirty Then
Exit Function
End If
Set rsc = Me.RecordsetClone
'for message box
mPrompt = "Warning: Possible Duplicate Record" & vbCr & vbCr
mPrompt = mPrompt & "Do you want to continue to add this record?" &
vbCr
& vbCr
mPrompt = mPrompt & "Select YES to add the record" & vbCr & vbCr
mPrompt = mPrompt & "Select NO to be taken to the record."
mButtons = vbYesNo + vbCritical + vbDefaultButton2
mTitle = "Duplicate Information"
'check that all criteria are entered
If IsNull(Me.tbLastName) Then
MsgBox "Last name is required!!", vbOKOnly + vbExclamation
DuplicateCheck = True
Me.tbLastName.SetFocus
Exit Function
End If
If IsNull(Me.tbFirstName) Then
MsgBox "First name is required!!", vbOKOnly + vbExclamation
DuplicateCheck = True
Me.tbFirstName.SetFocus
Exit Function
End If
If IsNull(Me.tbDOB) Then
MsgBox "Date of Birth is required!!", vbOKOnly + vbExclamation
'
DuplicateCheck = True
Me.tbDOB.SetFocus
Exit Function
End If
stLinkCriteria = "[strLastName]= '" & Me.tbLastName & "'"
stLinkCriteria = stLinkCriteria & " And [strFirstName]= '" &
Me.tbFirstName & "'"
stLinkCriteria = stLinkCriteria & " And [dtmDOB] = #" & Me.tbDOB &
"# "
rsc.FindFirst stLinkCriteria
'next 3 lines are for testing
' Debug.Print rsc!strLastName
' Debug.Print rsc!strFirstName
' Debug.Print rsc!dtmDOB
'always check the NoMatch property after a find
' rsc.NoMatch = TRUE means no duplicates
' rsc.NoMatch = FALSE means there are duplicates
' if rsc.NoMatch = FALSE, then NOT rsc.NoMatch is TRUE
' I hate negative logic!!!
'********changes here*************
If Not rsc.NoMatch Then
'possible duplicate record found
'ask if they want to goto the record or continue to add record
Response = MsgBox(mPrompt, mButtons, mTitle)
If Response = vbNo Then ' User chose No
'undo entries and goto record
Me.Undo
Me.Bookmark = rsc.Bookmark
Me.tbLastName.SetFocus
End If
End If
'*********************************
DuplicateCheck = False
'clean up
rsc.Close
Set rsc = Nothing
End Function
'------end code-------------------------
Hope someone will help me, may be Steve Sanford....
Many thanks to everyone,
Stefano.