Please bear with me here as I'm no vba expert. I have put together the following procedure which runs on the AfterUpdate
event of a textbox control on a form.
Private Sub ClientName_AfterUpdate()
Dim SearchChar, MyPos
Dim str As String
Dim substr As String
Dim rsc As DAO.Recordset
Dim msgstr As String
Dim j As Integer
Dim i As Integer
Dim CharLong As Integer
str = Me.ClientName 'the field that we want to check for similar or duplicate entries
SearchChar = " " 'the delimeter to use to split out 'substr' to search for
CharLong = 4 'the minumum character length for the 'substr' that is being searched for in
substr = ""
'find the first 'substr' in the 'str' over 'CharLong' characters long
For j = 1 To Len(str)
substr = substr & Mid(str, j, 1)
If Mid(str, j, 1) = SearchChar Then
If Len(Trim(substr)) < CharLong Then substr = "" Else Exit For
substr = Trim(substr)
'message box opening sentence...
msgstr = "You have entered: " & vbTab & Me.ClientName & vbCrLf & vbCrLf & _
"There are existing entries containing '" & substr & "' :" & vbCrLf & vbCrLf
Set rsc = Me.RecordsetClone
'Determines if this is a new record or not
If Me.NewRecord Then
If Me.ClientName.Value & "" = "" Then
.FindFirst ("ClientName Like '*" & substr & "*'")
i = 0
Do Until .NoMatch = True
If .NoMatch = True Then GoTo message
msgstr = msgstr & " ClientID: " & rsc.Fields("ClientID").Value & vbTab & "- " & _
rsc.Fields("ClientName").Value & vbCrLf
.FindNext ("ClientName Like '*" & substr & "*'")
i = i + 1
If i = 0 Then Exit Sub ' no matches - carry on user entry.
msgstr = msgstr & vbCrLf & vbCrLf & "Do you still want to create a new entry ?"
response = MsgBox(msgstr, vbYesNo, "Duplicate Entry Warning")
If response = vbYes Then
'nothing - allow the user to continue entering the record
Me.Undo 'don't add the record
The forms recordsource is an linked table (from SQL Server)
The procedure ran beautifully when it was on my test access database (which wasn't split FE/BE and only had a few records).
Now, however, it takes ages to run. Is there anything I can do to speed it up ?
Also, sometimes it gives me a:
Run-time error 3163 - the field is too small to accept the amount of data that you are trying to put into it.
Upon debug the line starting .FindNext is highlighted...?? I'm stuck on this too... I've tried to debug it by looking at the
length of msgstr when the error occurs but not managed to get any further. (msgtr can get as long as 1000+ characters)
Any help will be greatly appreciated.