VBA macro: If Range Contains Words from Another Range Then Type x in Third Range - excel

Question

I would like to solve the following problem:
In Worksheet1 I have a range in text form from O3 to O4500. If the cells in this range contain certain words, I want an "x" to be put in the range U3:U4500 (in the same row). The words to be tested are in range B4:B15 in another Worksheet (Worksheet2).
I made it work with the following code (solution1), but now I don't want to type the code manually for word1, word2, words3... instead it should be taken from the other range in Worksheet 2 (see my draft below in solution2). I believe the problem are the "* *" which are missing when I use the referral to the other range.
Any help is very much appreciated!
Sub solution1()
Dim i As Long
For i = 3 To 4500
If LCase$(Worksheet1.Range("O" & i).Value) Like "*word1*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word2*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word3*" Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
End Sub
Sub solution2()
Dim i As Long, c As Long
For i = 3 To 4500
For c = 4 To 15
If LCase$(Worksheet1.Range("O" & i).Value) Like LCase$(Worksheet2.Range("B" & c).Value) Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
Next
End Sub

Answer 1

try something like:
Sub solution2()
Dim i As Long, c As Long
searchstring = LCase$(Worksheets("Worksheet2").Range("B1").Value & "|" & Worksheets("Worksheet2").Range("B2").Value & "|" & Worksheets("Worksheet2").Range("B3").Value)
For i = 2 To 9
If Len(LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) < 1 Then GoTo neexxtt
'line above prevents empty lines to be marked
If InStr(searchstring, LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) <> 0 Then Worksheets("Worksheet1").Range("U" & i).Value = "x"
neexxtt:
Next
End Sub

Answer 2

A VBA Lookup: Using an (Array)Formula For Partial Matches
In Excel, in cell U3, you could use the following array formula:
=IF(COUNT(MATCH("*"&Sheet2!$B$4:$B$15&"*",O3,0))>0,"X","")
and copy it down (adjust the lookup worksheet name (Sheet2)).
The following solution is based on this formula avoiding any loops.
Sub VBALookup()
Const Flag As String = "x"
' Reference the ranges.
Dim srg As Range ' Source
Dim drg As Range ' Destination
Dim lrg As Range ' Lookup
With Worksheet1
Set srg = .Range("O3", .Cells(.Rows.Count, "O").End(xlUp))
Set drg = srg.EntireRow.Columns("U")
End With
With Worksheet2
Set lrg = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With
' Build the array formula.
Dim ArrayFormula As String
ArrayFormula = "=IF(COUNT(MATCH(""*""&'" & Worksheet2.Name & "'!" _
& lrg.Address & "&""*""," & srg.Cells(1).Address(0, 0) & ",0))>0,""" _
& Flag & ""","""")"
' Write the formulae (values).
With drg
' Write the array formula to the first cell.
.Cells(1).FormulaArray = ArrayFormula
' Autofill to the bottom.
.Cells(1).AutoFill .Cells, xlFillDefault
' Not sure, but instead of the previous 2 lines, in Office 365,
' the following single line should work:
'.Cells.Formula = ArrayFormula
' Convert to values (out-comment if you want to keep the formulae).
.Value = .Value
End With
End Sub