Compare 2 columns that contain sentences and return matching words in the 3rd column

[mypa333]

Column A	Column B	Column C
appartement a louer	appartement a louer limoges	appartement a louer
appartement a louer	appartement grece	appartement
barcelone	hotels a gotic	No Match
barcelone	barcelone hotel	barcelone
borussia dortmund liverpool	dortmund hotels	dortmund
Hotel in Livigno	Hotel in Livigno	Exact Match
camping car occasion	camping village rosselba le palme portoferraio	camping
camping car occasion	eurocamping oliva	No Match
five nights at freddy 4	freddy desert nights camp hotel	nights freddy

<colgroup><col><col><col></colgroup><tbody>
</tbody>

I need help in comparing each word in column A with each word in column B and returning the matched words in column C.
I can use a IF(A2=B2, true, false) to flag exact matches or no matches but I've been struggling(a lot, to the point of obsession) to get the matched words list.
I've been running a macro that would TextToColumns both columns, then Hlookup each resulting words from B to A, then concat the matched words = 30-60 min depending on the mood of my laptop.

Thank you

 

[Marcelo Branco]

Maybe this UDF (User Defined Function)

Alt+F11 to oen the VBEditor
Menu
Insert > Module
Copy and paste the code b elow in the right panel

Function GetMatches(s1 As String, s2 As String)
    Dim spl1 As Variant, spl2 As Variant, i As Long
    
    If s1 = s2 Then GetMatches = "Exact Match": Exit Function
    
    spl1 = Split(Application.Trim(s1))
    spl2 = Split(Application.Trim(s2))
    
    For i = 0 To UBound(spl1)
           If Not IsError(Application.Match(spl1(i), spl2, 0)) Then GetMatches = GetMatches & " " & spl1(i)
    Next i
    If Len(GetMatches) = 0 Then
        GetMatches = "No Match"
    Else
        GetMatches = Application.Trim(GetMatches)
    End If
End Function

Back to Excel

Formula in C2
=GetMatches(A2,B2)
copy down

	A​	B​	C​
1​	Text1​	Text2​	Result​
2​	appartement a louer​	appartement a louer limoges​	appartement a louer​
3​	appartement a louer​	appartement grece​	appartement​
4​	barcelone​	hotels a gotic​	No Match​
5​	barcelone​	barcelone hotel​	barcelone​
6​	borussia dortmund liverpool​	dortmund hotels​	dortmund​
7​	Hotel in Livigno​	Hotel in Livigno​	Exact Match​
8​	camping car occasion​	camping village rosselba le palme portoferraio​	camping​
9​	camping car occasion​	eurocamping oliva​	No Match​
10​	five nights at freddy 4​	freddy desert nights camp hotel​	nights freddy​

Hope this helps

M.

 

[mypa333]

Marcelo, this is absolutely awesome.
The code is very "elegant" compared to my texttocolumns macro.

My obsession is over. Now, I can rest. Many thanks!

 

[Marcelo Branco]

You are welcome. Glad to help

M.

 

[mypa333]

Hello again,

I've been running this for the last month and while it cut down the time spent in half, I still need to manually go through variations(E.g. plurals, words with accents, misspelled words), such as:

E.g. Apartments in barcalone vs apartments in barcelona - or - renting cars vs rent a car. The Levenstehein distance is 2 in the first case and in the second case is 5 for the "ing" and the "a".

Basically, I want to calculate the sum of the Levensthein distance returned when the above code compares the 2 words. My logic is that if the LD is closer to zero, the better the match it is.

Integrated in the above code or as a separate function, anything will help! Thank you! The below is helpful just on a word by word basis. The code above compares each word so if I can add this in the loop, it will absolutely rock!

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">Function Levenshtein(ByVal string1 As String, ByVal string2 As String) As Long

Dim i As Long, j As Long
Dim string1_length As Long
Dim string2_length As Long
Dim distance() As Long

string1_length = Len(string1)
string2_length = Len(string2)
ReDim distance(string1_length, string2_length)

For i = 0 To string1_length
distance(i, 0) = i
Next

For j = 0 To string2_length
distance(0, j) = j
Next

For i = 1 To string1_length
For j = 1 To string2_length
If Asc(Mid$(string1, i, 1)) = Asc(Mid$(string2, j, 1)) Then
distance(i, j) = distance(i - 1, j - 1)
Else
distance(i, j) = Application.WorksheetFunction.Min _
(distance(i - 1, j) + 1, _
distance(i, j - 1) + 1, _
distance(i - 1, j - 1) + 1)
End If
Next
Next

Levenshtein = distance(string1_length, string2_length)

End Function</code>

 

[mypa333]

I realized this makes close to no sense. Will post a better logic and my code if I get it to work in any way. Thanks.

 

[mypa333]

This just hit me ... What if I merge the words in each column, calculate the Levensthein Distance using the above formula and calculate a weighted percentage match between the length of characters of the 2 strings and also keep the initial code and make an assumption if it's a good match or a bad match.