Find whole word matches in two strings?

[Lord Sandwich]

Hi, I'm trying to create a function that can take two strings and return the number of matching whole words, for instance:

String1: "Al Roker"
String2: "Al Bundy"
Result: 1

String1: "All your base are belong to us"
String1: "All your bases are ours"
Result: 3

I figure I'd need to break up each string and place the words into arrays, but beyond that I have no idea how to proceed.

 

[Lord Sandwich]

Heh, I was able to cobble something together:

Public Function CompareWords(strInput1 As String, strInput2 As String) As Integer
    Dim strTemp As String
    Dim lngPointer As Long
    Dim strOutput1(64) As String, strOutput2(64) As String
    Dim X As Integer, Y As Integer, I As Integer
    
    X = 1
    
    Do Until strInput1 = ""
        lngPointer = InStr(1, strInput1, " ")
        If lngPointer > 0 Then
            strTemp = Left(strInput1, lngPointer - 1)
            strInput1 = Right(strInput1, Len(strInput1) - lngPointer)
            Else
                strTemp = strInput1
                strInput1 = ""
        End If
        If strTemp <> "" Then strOutput1(X) = strTemp
        X = X + 1
    Loop

    Y = 1
    
    Do Until strInput2 = ""
        lngPointer = InStr(1, strInput2, " ")
        If lngPointer > 0 Then
            strTemp = Left(strInput2, lngPointer - 1)
            strInput2 = Right(strInput2, Len(strInput2) - lngPointer)
            Else
                strTemp = strInput2
                strInput2 = ""
        End If
        If strTemp <> "" Then strOutput2(Y) = strTemp
        Y = Y + 1
    Loop

    I = 0
    
    For X = 1 To 64
        If Len(strOutput1(X)) > 0 Then
            For Y = 1 To 64
                If strOutput1(X) = strOutput2(Y) Then I = I + 1
            Next Y
        End If
    Next X
                
    CompareWords = I
    
End Function

Unfortunately the process is horribly slow for large-scale searches, and I'm using this to compare some 300 individuals to a federal watchlist with over 36,000 names.

any pointers?

 

[dt01pqt]

Well this is not how you search databases for one, like you say it is very process intensive. What are you trying to do compare each record field with the search string or compare one record field with the search string?

 

[DALeffler]

You might modify your code along these lines to improve the functions speed:

Function CompareWords()
Dim strInput1 as String, strInput2 as String
Dim strOutput1(64) as String, strOutput2(64) as String
Dim strTemp as String
Dim lngPointer as Long
Dim X as Integer, Y as Integer
Dim I as Integer, J as Integer
Dim MatchCount as Integer

strInput1 = "  Test  Best   Jest  .   Lest     Nest   ,   Pest   E O F     +"
strInput2 = "Test  = D P G >         Lest           Rest       E OF"

strTemp = strInput1
strTemp = Trim(strTemp)
lngPointer = InStr(1, strTemp, " ")
X = 0

While lngPointer > 0
     X = X + 1
     strOutput1(X) = Mid(strTemp, 1, lngPointer - 1)
     strTemp = Mid(strTemp, lngPointer)
     strTemp = LTrim(strTemp)
     lngPointer = InStr(1, strTemp, " ")
Wend

If Len(strTemp) > 0 Then
     X = X + 1
     strOutput1(X) = strTemp
End If

strTemp = strInput2
strTemp = Trim(strTemp)
lngPointer = InStr(1, strTemp, " ")
Y = 0

While lngPointer > 0
     Y = Y + 1
     strOutput2(Y) = Mid(strTemp, 1, lngPointer - 1)
     strTemp = Mid(strTemp, lngPointer)
     strTemp = LTrim(strTemp)
     lngPointer = InStr(1, strTemp, " ")
Wend

If Len(strTemp) > 0 Then
     Y = Y + 1
     strOutput2(Y) = strTemp
End If

MatchCount = 0

For I = 1 to X
     For J = 1 to Y
          If strOutput1(I) = strOutput2(J) Then Matchcount = MatchCount + 1
     Next J
Next I

Debug.Print MatchCount

End Function

It's still going to be way slow for thousands of function calls, but it should help...

 

[MarkK]

In versions above 97, you might also investigate the Split() function, which converts a delimited string into an array.

 

[Lord Sandwich]

Thanks all. I took dt01pqt's input and dumped the strings into tables to sort them out with a saved query. Works a lot better, and I'll try the other options soon as I get home.