Error 13 when searching for string matching range values

Col A of Sheet 2 has a series of "keywords"

Col B on sheet 1 has a list of products.

Macro should "cycle" through each product to find matches with any keyword.

If a match is found. the keyword should be added to Col C of the row

If no match is found, Col C of the row becomes "Other"

Code is throwing an Error 13 "Type Mismatch"

Option Explicit

Sub findmatch()

Dim b As Long, d As Long, x As Long

'Find last row of data

    With Sheet1
    b = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    For x = 2 To b
    For d = 2 To 6
 
'Checks whether B* contains the first keyword in Sheet 2

    If InStr(Range("B" & x).Value, Sheet2.Range("a" & d), vbTextCompare) <> 0 Then 
    Range("C" & x) = Sheet2.Range("a" & d)
    End If

    Next

'If none of the keywords match, put "Other" in Col C
    Range("C" & x) = "Other"

'Repeat for next row

    Next

End Sub

Suggestions and pointers welcome as ever

Ochimus