[AccessD] "fuzzy logic" search

>Would you mind sharing the revised code, please?

Function HammingDistance(BaseString As String, TestString As String) As Long
On Error GoTo Err_HammingDistance
Dim lngHamCount As Long
Dim lngLen As Long
Dim loopcount As Integer

lngLen = Len(BaseString)
If Len(TestString) <> lngLen Then
    HammingDistance = -1
    Exit Function
Else
  For loopcount = 1 To lngLen
     If Mid$(BaseString, loopcount, 1) <> Mid$(TestString, loopcount, 1)
Then
        lngHamCount = lngHamCount + 1
     End If
  Next
End If
HammingDistance = lngHamCount
Exit_HammingDistance:
Exit Function
Err_HammingDistance:
        MsgBox err.Description, , "Error in Function
basSoundex.HammingDistance"

        Resume Exit_HammingDistance
    Resume 0    '.FOR TROUBLESHOOTING
End Function

Function CheckSum(TestString) As Long
On Error GoTo Err_CheckSum
Dim lngCheck As Long
Dim loopcount As Integer
For loopcount = 1 To Len(TestString)
   lngCheck = lngCheck + Asc(Mid$(TestString, loopcount, 1))
Next
Exit_CheckSum:
Exit Function
Err_CheckSum:
        MsgBox err.Description, , "Error in Function basSoundex.CheckSum"

        Resume Exit_CheckSum
    Resume 0    '.FOR TROUBLESHOOTING
End Function

Function PossibleMatch(BaseString As String, TestString As String) As
Boolean
On Error GoTo Err_PossibleMatch
    If BaseString = TestString Then
        PossibleMatch = True
    Else
        Select Case HammingDistance(BaseString, TestString)
            Case 1 ' Miskey?
               PossibleMatch = True
            Case 2  'Possible transposition?
               If CheckSum(BaseString) = CheckSum(TestString) Then
                   PossibleMatch = True
               End If
            Case Else
               PossibleMatch = False
        End Select
    End If
Exit_PossibleMatch:
Exit Function
Err_PossibleMatch:
        MsgBox err.Description, , "Error in Function
basSoundex.PossibleMatch"

        Resume Exit_PossibleMatch
    Resume 0    '.FOR TROUBLESHOOTING
End Function


John W. Colby
www.colbyconsulting.com

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Gustav Brock
Sent: Wednesday, October 22, 2003 9:54 AM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] "fuzzy logic" search


Hi John, Stewart

Would you mind sharing the revised code, please?

/gustav


> Stewart,

> With the outlined changes, the code is working GREAT!!!  ..

_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com