VBA – Excel – Count the Number of Matching Words in Two Strings

Possibly useful to sort, order or compare lists of non-identical but related strings.

Public Function MatchingWordsInStrings(InString1 As String, InString2 As String) As Integer

'Loop through two strings, counting the number of matches that exist - useful as a rough comparison of similarity
Dim StrArr1() As String, StrArr2() As String
Dim RetCnt As Integer: RetCnt = 0
Dim Ele1 As Variant, Ele2 As Variant

'If either string is empty, no comparison can be done, return 0
If InString1 = "" Or InString2 = "" Then
MatchingWordsInStrings = 0
Exit Function
End If

'Split strings into arrays of words to allow comparison
StrArr1 = Split(InString1, " ")
StrArr2 = Split(InString2, " ")

'Compare each word in first array with each word in 2nd array
For Each Ele1 In StrArr1
    For Each Ele2 In StrArr2
        If Ele1 = Ele2 Then
            RetCnt = RetCnt + 1
            Exit For
        End If
    Next Ele2
Next Ele1

MatchingWordsInStrings = RetCnt
End Function