Compare two strings and count character/spaces/letter in difference

[fredrerik84]

Hi guys , Im strugling with string that have same meaning but different spelling , here is a sample

string1: MFK Ruzomberok
string2: Ruzomberok

I need to figure out a way to count the number of different letters , I guess difference in these two strings should be 4 , but anyone know I ninja code that can calculate this?

best regards

 

[TonyUK72]

In it's simplest form if the longer string is in A1 and the shorter string is in B1, the formula in C1 would be:

=LEN(A1)-LEN(B1)

 

[fredrerik84]

Hi thanks for your reply.

Unfortentley it does not work like this as the string are generated completely random, and another string could be something like

string1: Argentina University (w)
string2: Argentina (w) University

or
str1: Bodo-Glimt
str2: Bodø/Glimt

edit: (and they can be completley difrent like:

str1: Flora Tallinn
str2: Braunschweig

I really need to know exactly how many letters are different in these. Because i need to work out how much difference I can tolerate

 

[fredrerik84]

luckily for me google was my friend and I found this:

How to compare the similarity of two words in VB?-VBForums

quite interesting

... and it look like I need around 75% match or better for my work

 

[fredrerik84]

Ive been working with this problem all day. And I think im very close to solution.

I run this VLookLike code, then i run another code to compare difference in results I figure 75% match or more is a correct for my usage. However this code tend to be a little slow or my data sample is quite high around 1000 rows ..

Function VLookLike(txt As String, rng As Range) As String
    Dim temp As String, e, n As Long, a()
    Static RegX As Object
    If RegX Is Nothing Then
        Set RegX = CreateObject("VBScript.RegExp")
        With RegX
            .Global = True
            .IgnoreCase = True
            .Pattern = "(\S+).*" & Chr(2) & ".*\1"
        End With
    End If
    With RegX
        For Each e In rng.Value
            If UCase$(e) = UCase(txt) Then
                VLookLike = e
                Exit For
            End If
            temp = Join$(Array(e, txt), Chr(2))
            If .test(temp) Then
                n = n + 1
                ReDim Preserve a(1 To 2, 1 To n)
                a(2, n) = e
                Do While .test(temp)
                    a(1, n) = a(1, n) + Len(.Execute(temp)(0).submatches(0))
                    temp = Replace(temp, .Execute(temp)(0).submatches(0), "")
                Loop
            End If
        Next
    End With
    If (VLookLike = "") * (n > 0) Then
        With Application
            VLookLike = .HLookup(.Max(.Index(a, 1, 0)), a, 2, False)
        End With
    End If
End Function

Is there so way to speed that code up?