Re: Extract similar words from selected sentences
B2:
=IFERROR(GetSimilar($A$2:$A$7,$I$2:$I$9,ROW(A1)),"")
and copy down
Code
Function GetSimilar(rng As Range, Exc As Range, ref As Long) As String
Dim r As Range, m As Object, e, myPtn As String
Dim RegX As Object, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
For Each r In Exc
If r.Value <> "" Then dic(r.Value) = Empty
Next
For Each r In rng
If r.Value <> "" Then
If RegX Is Nothing Then
Set RegX = CreateObject("VBScript.RegExp")
RegX.Global = True: RegX.IgnoreCase = True
RegX.Pattern = "[,\.:;\?!&\(\)\-\|\\\[\]\+\*\{\}]"
myPtn = Application.Trim(RegX.Replace(r.Value, " "))
RegX.Pattern = "\b(" & Replace(myPtn, " ", "|") & ")\b"
Else
For Each m In RegX.Execute(r.Value)
If Not dic.exists(m.submatches(0)) Then
myPtn = myPtn & "|" & m.submatches(0)
End If
Next
If Len(myPtn) Then
GetSimilar = Trim$(Replace(myPtn, "|", " "))
RegX.Pattern = "\b(" & Mid$(myPtn, 2) & ")\b"
Else
GetSimilar = "No word": Exit For
End If
myPtn = ""
End If
End If
Next
If Len(GetSimilar) Then GetSimilar = Split(GetSimilar)(ref - 1)
Set RegX = Nothing
Set dic = Nothing
End Function
Display More