vbaexcelexcel-formulaudf

Match Any Word Inside Cell With Any Word In Range of Cells


I have a list of phrases. I would like to check if any new terms match that list partially by word.

I'm looking for a code to implement fuzzy matching on the list to return the cell that has a close match.

Example Data:

enter image description here

Phrases,Terms
real term,new words
great work,new term
check phrase,more phrase
example here,great alpha
phrase random,beta new

Desired Output:

enter image description here

Phrases,Term,Match
real term,new words,No match
great work,new term,real term
check phrase,more phrase,check phrase/phrase random
example here,great alpha,great work
phrase random,beta new,No match

What I've got:

I tried using the following code to match the cell if it is found:

=IF(ISERROR(MATCH("*" & B2 & "*",A:A, 0)), "No Match", VLOOKUP("*" & B2 & "*",A:A,1,FALSE))

However, the code only matches the entire cell. How can I make it match any word in the cell? This would create a fuzzy match. Any positive input is highly appreciated.


Solution

  • Here is a (rough and ready) VBA solution to your question. You will need to insert it into a code module in the VBA editor and then you can run the macro to get your desired output

    Sub FindSimilar()
        Dim phrases As Range, phrase As Range
        Dim terms As Range, term As Range
        Dim matches As String
        Dim words() As String
    
        'ensure this has the correct sheet names for your workbook
        Set phrases = ThisWorkbook.Worksheets("Sheet2").Range("A2:A6")
        Set terms = ThisWorkbook.Worksheets("Sheet1").Range("D2:D6")
    
        For Each term In terms
            matches = vbNullString
            words() = Split(term.Value)
    
            For i = 0 To UBound(words, 1)
                For Each phrase In phrases
                    If InStr(1, phrase.Value, words(i)) Then
                        matches = matches & phrase & "/"
                    End If
                Next phrase
            Next i
    
            If matches <> vbNullString Then
                term.Offset(0, 5).Value = Left(matches, Len(matches) - 1)
            Else
                term.Offset(0, 5).Value = "No match"
            End If
        Next term
    End Sub