Find a word in a cell from a list of words

Alex-

Maybe try using this macro.  Since I cannot post a macro enabled workbook due to security risks.  You'll need to insert this code in a standard code module for it to work:

VBA:

Sub GetWords()

    Dim wrdLRow As Integer
    Dim wrdLp As Integer
    Dim CommentLrow As Integer
    Dim CommentLp As Integer
    Dim fndWord As Integer
    Dim Sht As Worksheet
    
    On Error Resume Next 'Suppress Errors... for when we don't find a match
    
    'Define worksheet that has data on it....
    Set Sht = Sheets("Sheet1")
    
    'Get last row for words based on column A
    wrdLRow = Sht.Cells(Rows.Count, "A").End(xlUp).Row
    
    'Get last row for comments based on column C
    CommentLrow = Sht.Cells(Rows.Count, "C").End(xlUp).Row
    
    'Loop through lists and find matches....
    For CommentLp = 2 To CommentLrow
    
        For wrdLp = 2 To wrdLRow

            'Look for word...
            fndWord = Application.WorksheetFunction.Search(Sht.Cells(wrdLp, "A"), Sht.Cells(CommentLp, "C"))
            
            'If we found the word....then
            If fndWord > 0 Then
                Sht.Cells(CommentLp, "D") = Sht.Cells(CommentLp, "D") & "; " & Sht.Cells(wrdLp, "A")
                fndWord = 0 'Reset Variable for next loop
            End If
            
        Next wrdLp
        
        Sht.Cells(CommentLp, "D") = Mid(Sht.Cells(CommentLp, "D"), 3, Len(Sht.Cells(CommentLp, "D")) - 2)

    Next CommentLp

End Sub

BEFORE:

AFTER: