Find words from an entire column in a cell

[sra233]

Hi,

please help me write a VBA code that searches a whole column of keywords in a cell of multiple words and once it finds at least one keyword in that cell, returns the value correspond to that keyword.

In sheet 1 which is the reference sheet:
Column 1: Keywords
Column 2: Code

[TABLE="width: 500"]
<tbody>[TR]
[TD]KeyWord
[/TD]
[TD]Code
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 152"]
<colgroup><col width="152"></colgroup><tbody>[TR]
[TD="class: xl65, width: 152"]Apple[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 111"]
<colgroup><col width="111"></colgroup><tbody>[TR]
[TD="class: xl67, width: 111"]100.00.1[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 152"]
<colgroup><col width="152"></colgroup><tbody>[TR]
[TD="class: xl67, width: 152"]Orange[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 111"]
<colgroup><col width="111"></colgroup><tbody>[TR]
[TD="class: xl67, width: 111"]200.00.2
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 152"]
<colgroup><col width="152"></colgroup><tbody>[TR]
[TD="class: xl67, width: 152"]Strawberry[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 111"]
<colgroup><col width="111"></colgroup><tbody>[TR]
[TD="class: xl67, width: 111"]300.00.3[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

In sheet 2:
Column 1: phrases ( description ) - could be combination of words, numbers and symbols
Column 2: ???? (Code found).[TABLE="width: 500"]
<tbody>[TR]
[TD][TABLE="width: 198"]
<colgroup><col width="198"></colgroup><tbody>[TR]
[TD="width: 198"]Description[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 142"]
<colgroup><col width="142"></colgroup><tbody>[TR]
[TD="class: xl67, width: 142"]My Code[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 198"]
<colgroup><col></colgroup><tbody>[TR]
[TD]apple-fruit [/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]???
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 198"]
<colgroup><col width="198"></colgroup><tbody>[TR]
[TD="width: 198"]red strawberry/N68L[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 102"]
<colgroup><col width="102"></colgroup><tbody>[TR]
[TD="width: 102"]???
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 198"]
<colgroup><col width="198"></colgroup><tbody>[TR]
[TD="width: 198"]I love orange[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]???
[/TD]
[/TR]
</tbody>[/TABLE]

I need to write a loop to search the 1st column in sheet 2 for any keywords that may be in column 1 sheet 1 and return the corresponding code to column 2 (my Code), sheet 2.

the loop should:
Takes apple-fruit, go to keyword column, search each keyword , find the it (apple), then assign the code.

please help.
Thanks

 

[JoeMo]

This assumes your headers in both sheets start in cell A1.

Sub CodeIfKeyword()
Dim S1 As Worksheet, S2 As Worksheet, R1 As Range, R2 As Range, lR1 As Long, lR2 As Long, i As Long
Dim vA1 As Variant, vA2 As Variant
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")
lR1 = S1.Range("A" & Rows.Count).End(xlUp).Row
lR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
Set R1 = S1.Range("A2", "A" & lR1)
Set R2 = S2.Range("A2", "A" & lR2)
vA1 = R1.Value
vA2 = R2.Value
Application.ScreenUpdating = False
For i = LBound(vA1, 1) To UBound(vA1, 1)
    For j = LBound(vA2, 1) To UBound(vA2, 1)
        If InStr(UCase(vA2(j, 1)), UCase(vA1(i, 1))) > 0 Then R2.Cells(j, 1).Offset(0, _
            1).Value = R1.Cells(i, 1).Offset(0, 1).Value
    Next j
Next i
End Sub