Excel VBA to search for list of keywords in a cell given a value in another cell and then make changes to a third cell

Question

UPDATE: UPDATE: Thank you all for your initial contribution, now I have worked through the code but I am stuck. It gives me an error ! plus I am not sure if my code will do the task needed .. here is the edited description :=

I have a list of guests whom each eats a certain type of vegetables. For instance John,Smith eats potato and tomato. While Bill,Peter eats Carrots,Onions. I have created a list along with keywords that looks like this

Now, I receive a data extract that has a list of names along with a free text description of the food they ate. Here is what i get

Unfortunately, I get the names in a format that I do not want like John,Smith (Primary Customer) and I want excel to add the vegetable they ate given it is written in the description. For example, John,Smith (Primary Customer) has the description as: "he had French fries and wedges" and since the description contains a keyword listed in my initial table for the same indivdual then his name will be changed from John,Smith (Primary Customer) to John,Smith-Potato (Primary Customer).

I want excel to check if the name exists in the first table first and then look through the description to find any keywords. This will make sure if the name at hand is not contained in my list then excel will not spend time looking for keywords. Also, if no keyword found then do not edit the name.

this is what I expect to get

With the help of you guys I was able to edit this code but it still gives me error and I am not sure if it does what I wanted it to do. Any ideas where to go from here?

here is the code :

Option Explicit
Sub homework()
Dim ws1 As Worksheet, ws2 As Worksheet, keywords() As String, lastRow As Integer, lastRow2 As Integer, c As Variant, x As Integer, y As Integer, k As Variant, cel As Range, descript As Range
Dim SrchRng As Range
Dim SrchStr As Variant
Set ws1 = Worksheets("Sheet2") 'the sheet that contains keywords which is the sheet i will make
Set ws2 = Worksheets("Sheet1") 'the sheet that contains description of food
lastRow = ws1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
lastRow2 = ws2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row
Set SrchRng = Worksheets("Sheet2").Range("A1:A1000")
Set descript = ws2.Range("C2:C" & lastRow2)
For x = 2 To lastRow ' this is to the last row in the database i will create
    keywords = Split(ws1.Cells(x, 3), ",")
    For Each k In keywords
        For Each cel In descript
        For y = 2 To lastRow2
        Do
        SrchStr = Left(ws2.Cells(y, 2), InStr(ws2.Cells(y, 2), " (") - 1)
        Set c = SrchRng.Find(SrchStr, LookIn:=xlValues)
            If Not SrchRng.Find(SrchStr, LookIn:=xlValues) Is Nothing And InStr(ws2.Cells(y, 3), k) <> 0 Then
                ws2.Cells(y, 2).Value = ws1.Cells(x, 1).Value & "-" & ws1.Cells(x, 2).Value
                SrchStr = Nothing
                Exit Do
                End If
        Loop While Not c Is Nothing
            Next y
        Next cel
    Next k
Next x
End Sub

Answer 1

You can start with this :

Sub test()

    Dim name As String          ' user name
    Dim vegetables() As String  ' available vegetables
    Dim v As Variant            ' item in vegetables
    Dim sentence As String      ' the text to search

    name = "John,Smith"
    vegetables() = Split("fries, potato, mashed", ", ")
    sentence = "he had french fries and wedges"
    For Each v In vegetables
        ' if sentence contains the keyword v
        If InStr(sentence, v) <> 0 Then
            Debug.Print "John,Smith" & "-" & v
        End If
    Next v

End Sub

Answer 2

There are other things you need to account for, such as that there are only three items in the description list, but 4 names in the first list, etc, but this will get you most of the way there:

    Option Explicit
    Sub homework()
    Dim ws1 As Worksheet, ws2 As Worksheet, keywords() As String, lastRow As Integer, lastRow2 As Integer, x As Integer, k As Variant, cel As Range, descript As Range
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    lastRow = ws1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastRow2 = ws2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Set descript = ws2.Range("B2:B" & lastRow2)
    For x = 2 To lastRow
        keywords = Split(ws1.Cells(x, 3), ",")
        For Each k In keywords
            For Each cel In descript
                If InStr(ws2.Cells(x, 2), k) <> 0 Then
                    ws1.Cells(x, 4).Value = ws1.Cells(x, 1).Value & "-" & ws1.Cells(x, 2).Value
                End If
            Next cel
        Next k
    Next x
   End Sub