Help needed with First/Last Name combinations

Does anyone know of or have any VBA code or similar logic that can
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/information-technology/10520-help-needed-first-last-name-combinations.html
help distinguish similar first/last name combinations? For example, we
would like to prompt the user of a possible match when any of the
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/showthread.php?t=10520
first/last names Robert Smith, or Bob Smith, or Robt. Smith are used
during data entry. All that is necessary is to alert the user so that
they can review any appropriate existing records.

We have done several google searches without any luck. Any and all
help is appreciated.

TC


*

 
Do share your immediate thoughts or reactions on this issue? We value your views! Login Now! or Sign Up Today! to share your views with us.. Gurfateh!

Tony Ciconte wrote:
: Does anyone know of or have any VBA code or similar logic that can
: help distinguish similar first/last name combinations? For example, we
: would like to prompt the user of a possible match when any of the
: first/last names Robert Smith, or Bob Smith, or Robt. Smith are used
: during data entry. All that is necessary is to alert the user so that
: they can review any appropriate existing records.

I wrote *very crude* code for this: it matches the alphanumeric
content of strings, *without any regard for order*, so although it
often works very well, you'll find some real howlers.
It sets a threshhold for matching that you can of course change.
Here's my code; excuse the numbers at the beginning of each line:
I got it from an Access export file before I learned how to export the
code alone.

--thelma

-----------------------------------------------------------------------

'------------------------------------------------------------------'
' RATEMATCH '
'------------------------------------------------------------------'
Function ratematch(ByVal listmember As String, _
ByVal guess As String) As Integer

372 '------------------------------------------------------------'
373 ' This Function computes a very crude 'match'-score for a '
374 ' tablemember as compared with a user entry that matched '
' no table member. It counts the alphanumeric characters '
' shared by the two, ignoring order and non alphanumeric '
' characters, but not collapsing duplicates. '
' Function Return: '
' 0=>match unlikely; 1=>exact match 2=>could be match '
378 '------------------------------------------------------------'
379
382
383 Dim guessLen As Integer
398 Dim gpos As Integer
399 Dim i As Integer
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/showthread.php?t=10520
400 Dim lenNow As Integer
384 Dim ListMemberLen As Integer
401 Dim match As Integer

402 Dim nexletter As String

420 Dim mFrac As Single

380 listmember = _
OnlyAlphaNumericChars(listmember) ' Remove nonalphanumerics

381 guess = _
OnlyAlphaNumericChars(guess) ' from strings to compare

386 ratematch = 0 ' Not a Match

388 ListMemberLen = Len(listmember) ' Length of String from List
389 If ListMemberLen = 0 Then _
Exit Function ' Null is not Valid Guess

391 guessLen = Len(guess) ' Length of User Input

393 If InStr(listmember, guess) = 1 And ListMemberLen = guessLen Then
394 ratematch = 1 ' Exact alphanumeric Match
395 Exit Function
396 End If
397
404 match = 0

405
406 For i = 1 To guessLen
407 lenNow = Len(listmember)
408 If lenNow = 0 Then Exit For ' No string left to search
409 nexletter = Mid(guess, i, 1)
410 gpos = InStr(listmember, nexletter) ' Seek char in table entry

411 If gpos > 0 Then ' Char Found
412 match = match + 1 ' Increment matchcount
413 listmember = _
414 Left(listmember, gpos - 1) & _
415 Right(listmember, lenNow - gpos) ' Remove char matched
416 End If

417 Next
418
419 ' Accept if Fraction of name matched >= mFrac
421 If ListMemberLen > 4 And guessLen > 4 Then
422 mFrac = 0.8
423 Else
424 mFrac = 0.75
425 End If
426
427 If ListMemberLen > 0 And guessLen > 0 Then
428 If match / ListMemberLen >= mFrac And _
match / guessLen >= mFrac Then
429 ratematch = 2 ' Acceptable Alphanum Match
430 End If
431 End If
432
433 End Function


435 Public Function OnlyAlphaNumericChars(ByVal OrigString As _
436 String) As String
437

438 '------------------------------------------'
439 ' I found this function on the internet: '
440 ' DevX.com '

441 ' http://www.freevbcode.com/ '
442 ' Author: Intelligent Solutions Inc. '
443 '------------------------------------------'

444
445 '************************************************* **********
446 'INPUT: Any String

447 'OUTPUT: The Input String with all non-alphanumeric characters
448 ' removed
449 '************************************************* **********

450 Dim lLen As Long
451 Dim sAns As String
452 Dim lCtr As Long

453 Dim sChar As String
454 Dim zap As Boolean
455

456
457 OrigString = Trim(OrigString)
458 lLen = Len(OrigString)

459
460 zap = OrigString Like "*[!0-9A-Za-z]*"
461 If zap = False Then

462 OnlyAlphaNumericChars = OrigString
463 Exit Function
464 End If

465
466 For lCtr = 1 To lLen
467 sChar = Mid(OrigString, lCtr, 1)

468 ' If IsAlphaNumeric(Mid(OrigString, lCtr, 1)) Then
469 If sChar Like "[0-9A-Za-z]" Then
470 sAns = sAns & sChar

471 End If
472 ' DoEvents '(optional, but if processing long string,
473 'necessary to prevent program from appearing to hang)

474 'if used, write your app so no re-entrancy into this function
Reference:: Sikh Philosophy Network http://www.sikhphilosophy.net/showthread.php?t=10520
475 'can occur)
476 Next

477
478 OnlyAlphaNumericChars = sAns
479

480 End Function
481
482 Private Function IsAlphaNumeric(sChr As String) As Boolean

483 IsAlphaNumeric = sChr Like "[0-9A-Za-z]"
484 End Function
485
-----------------------------------------------------------------------


: We have done several google searches without any luck. Any and all
: help is appreciated.

: TC