[RESOLVED] string comparison function

[Merri]

Frans C: I got some idle time, so I coded it. I put some more thought on it and came up with something relatively simple: no need to keep an index.

Here is the code:

Option Explicit
 
Public Function GetMatchString(String1 As String, String2 As String) As String
    Dim lngA As Long, lngB As Long, lngC As Long, lngD As Long
    Dim LongestString As String, CurString As String, CompareString As String
    
    If LenB(String1) = 0 Then Exit Function
    If LenB(String2) = 0 Then Exit Function
    
    For lngA = 1 To Len(String1)
        CompareString = String2
        lngB = 0
        Do Until lngB > 0 Or lngA > Len(String1)
            lngB = InStr(CompareString, Mid$(String1, lngA, 1))
            If lngB < 1 Then lngA = lngA + 1
        Loop
        If lngA > Len(String1) Then Exit For
        Do
            lngC = 1
            Do
                If lngA + lngC > Len(String1) Then Exit Do
                If lngB + lngC > Len(CompareString) Then Exit Do
                If Mid$(String1, lngA + lngC, 1) = Mid$(String2, lngB + lngC, 1) Then
                    If lngC = 1 Then CurString = CurString & Mid$(String1, lngA, 1): Mid$(CompareString, lngB, 1) = vbNullChar
                    CurString = CurString & Mid$(String1, lngA + lngC, 1)
                    Mid$(CompareString, lngB + lngC, 1) = vbNullChar
                    lngC = lngC + 1
                Else
                    If lngC = 1 Then
                        lngD = InStr(lngB + 1, CompareString, Mid$(String1, lngA, 1))
                        If lngD > 1 Then
                            lngB = lngD
                        Else
                            Exit Do
                        End If
                    Else
                        Exit Do
                    End If
                End If
            Loop
            lngD = 0
            Do Until lngD > 0 Or lngA + lngC > Len(String1)
                lngD = InStr(CompareString, Mid$(String1, lngA + lngC, 1))
                If lngD < 1 Then lngC = lngC + 1
            Loop
            If lngD > 0 Then
                lngB = lngD
                lngA = lngA + lngC
            Else
                Exit Do
            End If
        Loop
        If LenB(CurString) > LenB(LongestString) Then LongestString = CurString
        CurString = vbNullString
    Next lngA
    GetMatchString = LongestString
End Function
Private Sub Form_Load()
    MsgBox GetMatchString("123456789012345", "123456790123450")
    MsgBox GetMatchString("it works nicely!", " nicely, it works!")
End Sub

As you can see, it returns the matched characters. If you only want to get the number of characters, just use Len()


Edit: Polished it! It should now work well enough for any combination you need