Search for columns for keywords from a list and return any matches to a different column

[Gaminggeek67]

Hello and thanks in advance for any assistance. I have a work sheet with two tabs named DATA PULL and LIST. The LIST tab contains a list of keywords (250 words) in column A. I need to search for those key words in columns P and Q on the DATA PULL tab and return any matches to column I(the data is in a table). Columns P and Q contain multiple words or sentences.

The code below does what I need but the list of key words is on the same sheet. This code also deletes letters from my table headers for some reason.

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("DATA PULL")

'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, "P").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, "P"))

'If we found the word....then
If fndWord > 0 Then
Sht.Cells(CommentLp, "I") = Sht.Cells(CommentLp, "I") & "; " & Sht.Cells(wrdLp, "A")
fndWord = 0 'Reset Variable for next loop
End If

Next wrdLp

Sht.Cells(CommentLp, "I") = Mid(Sht.Cells(CommentLp, "I"), 3, Len(Sht.Cells(CommentLp, "I")) - 2)


Next CommentLp


End Sub

Any help is greatly appreciated.