Help with text string match

[ZMAN2]

Is there existing coding or functions that will compare two text strings in different fields for a match of a certain # of consecutive characters? For example,

Field A
12WE34555

Field B
333FTY7812W

If the function was set to find 3 consecutive characters that match in the two fields the answer would be "Yes" it found 3 characters that match and the 3 characters are "12W".

How extensive is the coding required for this task?

Any help or guidance is appreciated.

 

[Newman]

I give it a try, but I didn't test it and typed it very fast. But, it should give you a good start.

Public function FindConsecutiveCharacters (NbrOfConsecutiveCharacters)
    Dim ConsecutiveCharacters as string
    Dim Pos as integer

    Pos = 1
    Do while Pos < Len(Field1)-NbrOfConsecutiveCharacters
        ConsecutiveCharacters = Mid(Field1, Pos , NbrOfConsecutiveCharacters)
        If Instr(Field2, ConsecutiveCharacters) > 0 then
            FindConsecutiveCharacters = "Yes! " & ConsecutiveCharacters
            Exit Do
        Endif
        Pos=Pos+1 'EDIT: Sorry! I forgot that important line.
    Loop
    If FindConsecutiveCharacters = "" then
        FindConsecutiveCharacters = "Sorry, No match!"
    Endif
End Sub

 

[dcx693]

Do you mean that you want to be able to find a match of any number of characters from your first string within the second? With the aim being finding the longest one?

I would suggest using the Instr() function for this. You'd have to start with the first character in the first string, see if it's found, then see if the first two are found, then if the first three are found, etc...all the way until you check to see if the entire 1st string is found within the 2nd. Then do the same with strings starting with the 2nd character, etc... Just a bunch of loop where you need to keep track of the longest string found.

 

[WayneRyan]

zman,

Public Function FindMatch(strA As String, strB As String, lngLength As Long) As String
Dim i As Integer
' Is part of "A" in "B"?
For i = 1 To (Len(strA) - lngLength)
   If InStr(i, strA, Mid(strB, i, lngLength)) > 0 Then
      FindMatch = "Yes"
      Exit Function
   End If
   Next i
End Function

Wayne

 

[billyr]

No good deed goes unpunished. I played with Newman's function and came up with this. Not a lot of difference except it returns "ERROR" if the number of characters specified is greater than the length of strFind.

Public Function TestCharMatch(NbrOfChars, StrSearch As String, strFind As String) As String
'Walks through strFind, NbrofChars at at time, and searches strSearch for a match.
If NbrOfChars > Len(strFind) Then
TestCharMatch = "ERROR!"
Exit Function
End If
Dim Pos As Integer
Pos = 1
Do While Pos <= (Len(strFind) - (NbrOfChars - 1))
If InStr(StrSearch, Mid(strFind, Pos, NbrOfChars)) > 0 Then
TestCharMatch = "Yes! " & Mid(strFind, Pos, NbrOfChars)
Exit Do
Else
TestCharMatch = "Sorry no match!"
End If
Pos = Pos + 1
Loop
End Function

 

[ChrisO]

Nice question…very nice.

Well it’s a little more difficult than it seems.

The aim seems to me to pass in two unknown strings with a length delimiter and possibly a string compare argument.

The procedure should return the number of compares, including zero, of any match found between the source (length delimitated) and destination strings.

I plagiarized Newman’s code because it seems the closest to the answer.
(Nice chunk of code without testing Newman.)

Option Explicit
Option Compare Text


Sub TestIt()
    Dim lngNumChar As Long
    Dim FieldA     As String
    Dim FieldB     As String
    
    [color=green]' ------------
    ' Test 1[/color]
    lngNumChar = 3
    FieldA = "12WE34555"
    FieldB = "333FTY7812W"
    
    MsgBox "Test 1 number of Matchers = " & _
           FindConsecutiveCharacters(FieldA, FieldB, lngNumChar)
    [color=green]' ------------


    ' ------------
    ' Test 2[/color]
    lngNumChar = 3
    FieldA = "12WA34555"
    FieldB = "333FTY7812WA12WAB"

    MsgBox "Test 2 number of Matchers = " & _
           FindConsecutiveCharacters(FieldA, FieldB, lngNumChar)
    [color=green]' ------------


    ' ------------
    ' Test 3[/color]
    lngNumChar = 3
    FieldA = "12WA34555"
    FieldB = "333FTY7812WA12W"

    MsgBox "Test 3 number of Matchers = " & _
           FindConsecutiveCharacters(FieldA, FieldB, lngNumChar)
    [color=green]' ------------


    ' ------------
    ' Test 4[/color]
    lngNumChar = 3
    FieldA = "12WE34555"
    FieldB = "333fty7812w"
    
    MsgBox "Test 4 number of Matchers = " & _
           FindConsecutiveCharacters(FieldA, FieldB, lngNumChar, vbBinaryCompare)
    [color=green]' ------------


    ' ------------
    ' Test 5[/color]
    lngNumChar = 4
    FieldA = "12WA34555"
    FieldB = "333fty7812wa12wab"

    MsgBox "Test 5 number of Matchers = " & _
           FindConsecutiveCharacters(FieldA, FieldB, lngNumChar, vbBinaryCompare)
    [color=green]' ------------[/color]

End Sub



Public Function FindConsecutiveCharacters(ByVal strSource As String, _
                                          ByVal strDestination As String, _
                                          ByVal lngNumCharacters, _
                                 Optional ByVal vntCompare As Variant = vbTextCompare) As Long
    
    Dim lngNumFinds            As Long
    Dim lngSourcePosition      As Long
    Dim lngDestinationPosition As Long
    Dim strCharacters          As String

    lngSourcePosition = 1
    lngDestinationPosition = 1
    
    Do While lngSourcePosition <= Len(strSource) - lngNumCharacters + 1
        strCharacters = Mid$(strSource, lngSourcePosition, lngNumCharacters)
        
        If (Len(strCharacters) = lngNumCharacters) Then
            If InStr(lngDestinationPosition, strDestination, strCharacters, vntCompare) > 0 Then
                lngNumFinds = lngNumFinds + 1
            End If
            lngSourcePosition = lngSourcePosition + 1
        Else
            lngSourcePosition = 1
        End If
        
        lngDestinationPosition = lngDestinationPosition + 1
    Loop
    
    FindConsecutiveCharacters = lngNumFinds
    
End Function

I hope the limited test cases provided prove the point.


Regards,
Chris.

 

[ZMAN2]

Thanks to everyone for all your help. I have attached a copy of all of the coding submitted in a small db, just in case anyone else is interested in this subject and results. It looks like Billy's changes to the original code submitted by Newman did the trick. I have attempted to setup an example of each scenario, however I admit I probably goofed up some of the other examples.

Billy, is it possible to put the result of your function in separate columns? One column for the immediate answer of "Yes" or "No" and the other column for the result of the match.

Thanks again. Great forum!

 

[billyr]

ZMAN2,
Look at the attached db1.zip; the function is changed to what you want. Open frmtest2 and try it out. (The function is in the module, "Utilities".) The call for the function and processing of the text boxes is in the onClick event for the command button. Have fun.

 

[nserrano]

Thank you all for posting this. It has been a tremendous help. I especially found Billy's code useful. I do, however, want to pose a question. In Billy's code, you can compare two fields and you have to select how many characters to match. Is there any way to modify the code so you don't have to select the number of characters to match but instead it displays the longest number of characters and the percentage (and if possible the second longest number of characters and the percentage of match).

Example Current code

Table1
FieldA ^ FieldB​

Serrano,N ^ Serrano,Noel
R, John ^ R MD, John
John,Brent ^ John,B Trent
Chicago,IL ^ Chicago, Illinois
680 N LakeShore Dr ^ 680 Lake Shore
60611-2314 ^ 60611
342-55-2035 ^ 342662035
312-555-1212 ^ 3125551212
123 Main St ^ 123 1st Ave

Billy's Code (current using 4 characters to match)​

FieldA ^ FieldB ^ Test​

John,Brent ^ John,B Tront ^ Yes! John
342-55-2035 ^ 342662035 ^ Yes! 2035
R, John ^ R MD, John ^ Yes! , Jo
Chicago,IL ^ Chicago, Illinois ^ Yes! Chic
312-555-1212 ^ 3125551212 ^ Yes! 1212
60611-2314 ^ 60611 ^ Yes! 6061
Serrano,N ^ Serrano,Noel ^ Yes! Serr
680 N LakeShore Dr ^ 680 Lake Shore ^ Yes! 680
123 Main St ^ 123 1st Ave ^ Yes! 123

Desired Output
FieldA ^ FieldB ^ Matches ^ Percent (match / longest field) ^ 2nd largest match ^ Percent (match / longest field) ^ Total percentage match ^ Did not match (excludes matches) ^ Percentage not match
John,Brent ^ John,B Tront ^"John,B"^50.0%^"nt"^16.7%^66.7%^" Tro"^33.3%
342-55-2035^342662035^"2035"^36.4%^"342"^27.3%^63.6%^"-55-"^
36.4%
R, John^R MD, John^", John"^60.0%^"R"^10.0%^70.0%^" MD"^30.0%
Chicago,IL^Chicago, Illinois^"Chicago,"^47.1%^"Il"^11.8%^58.8%^"linois" & " "^41.2%
312-555-1212^3125551212^"1212"^33.3%^"312" & "555"^50.0%^83.3%^"-" & "-"^16.7%
60611-23146^60611^"60611"^50.0%^NULL^0.0%^50.0%^"-2314"^50.0%
Serrano,N^Serrano,Noel^"Serrano,N"^75.0%^NULL^0.0%^75.0%^"oel"^25.0%
680 N LakeShore Dr^680 Lake Shore^"Shore "^33.3%^" Lake"^27.8%^61.1%^"N" & "Dr"^16.7%
123 Main St^123 1st Ave^"123 "^36.4%^NULL^0.0%^36.4%^"1st Ave"^63.6%


Original Code from Billy:

Option Compare Database

Public Function TestCharMatch(NbrOfChars, StrSearch As String, strFind As String) As String
'Walks through strFind, NbrofChars at at time, and searches strSearch for a match.
If NbrOfChars > Len(strFind) Then
TestCharMatch = "ERROR!"
Exit Function
End If
Dim Pos As Integer
Pos = 1
Do While Pos <= (Len(strFind) - (NbrOfChars - 1))
If InStr(StrSearch, Mid(strFind, Pos, NbrOfChars)) > 0 Then
TestCharMatch = "Yes! " & Mid(strFind, Pos, NbrOfChars)
Exit Do
Else
TestCharMatch = "Sorry no match!"
End If
Pos = Pos + 1
Loop
End Function


Any help will be greatly appreciated
Noel

 

[WayneRyan]

n,

I'm not going to worry about the percentages, but I hope this helps.

This is not tested, but I think the principle is correct. It will return the largest "chunk"
of strFind that is located within strDomain.

Public Function FindString(strFind As String, strDomain As String) As String
Dim ptr As Integer
Dim Length As Integer
Dim LongestLength As Integer
Dim Temp As String

Temp = ""
LongestLength = 0
'
' Walk through the Search String
'     Each iteration will search for "chunks" of strFind and record the Largest segment
'     that had a hit.  If it's longer than LongestLength, it will change the value and save 
'     the resultant string for the return value.
'
For ptr = 1 To Len(strFind)
   For Length = 1 to Len(strFind) - ptr
         If InStr(1, Mid(strFind, ptr, Length), strDomain) > 0 And Length > LongestLength Then
             Temp = Mid(strFind, ptr, Length)
             LongestLength = Length
         End If
      Next Length
   Next Ptr

FindString = Temp

End Function

hth,
Wayne