Identifying Multiple Text Matches in Excel

[Tenielle]

Hi,

I have the below fields in one sheet:

Sheet 1

INGREDENTS*

BHA, Coal, Amber

In another sheet (sheet 2) I have the below ingredients listed.

What I would like to do is identify whether any ingredient names that appear in the above cell (multiple ingredient names with spaces or comms between them, regardless of sentence case) also appears in the below list.

I would like to highlight the matches in the cell above (Sheet 1), for example BHA and Coal would both be in red as they appear in the list below but Amber would stay black, can anyone help? I have been trying to figure this out for hours

Sheet 2

INGREDIENTS*

Aluminum Chlorohydrate

1,4 - Dioxane

Acrylates

Animal Derived Ingredients

Avobenzone

BHA (Butylates Hydroxyanisole)

BHT (Butylates Hydroxytoluene)

Butoxythanol

Cadmium

Chemical UV Blocks - Titanium, Benzophenone, Oxybenzone, Homosalate and Octinoxate.

Coal Tar

Cyclic Silicones (also known as Siloxanes)

Ethanolamines

Ethylenediaminetetraacetic (EDTA)

Foraldehyde

Hydroquinone

Lead

luminum Powder

Mercury and Mercury compounds

Methyl cellosolve

Methylchloroisothiazolinone

Methylisothiazonlinone

Mineral Oil

Nanoparticles

Nickel

[#2]

@Tenielle 

It would be much easier if you entered the three ingredients on Sheet 1 in three separate cells. You can then use conditional formatting - see the attached sample workbook.

With the three ingredients in a single cell, you need VBA:

Sub Button1_Click()
    Dim r As Range
    Dim c As Range
    Dim s As String
    Dim p() As String
    Dim w As Variant
    With Worksheets("Sheet2")
        Set r = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    End With
    Set c = Worksheets("Sheet1").Range("A2")
    c.Font.ColorIndex = xlColorIndexAutomatic
    s = c.Value
    p = Split(s, ", ")
    For Each w In p
        If Not r.Find(What:=w, LookAt:=xlPart) Is Nothing Then
            c.Characters(Start:=InStr(s, w), Length:=Len(w)).Font.Color = vbRed
        End If
    Next w
End Sub

Demo workbook attached.

[#3]

@Hans Vogelaar Your amazing!! thank you so much Hans. I used the VBA and it worked thank you so much :) 

[#4]

If I wanted the button to also highlight ingredient that matched the ingredient sheet in Sheet1 from cell A2:A100 how would the code in VBA change?

[#5]

Sub Button1_Click()
Dim r As Range
Dim c As Range
Dim s As String
Dim p() As String
Dim w As Variant
With Worksheets("Sheet2")
Set r = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
End With
for each c in sheets("sheet1").range("A2:A100")
rem Set c = Worksheets("Sheet1").Range("A2")
c.Font.ColorIndex = xlColorIndexAutomatic
s = c.Value
p = Split(s, ", ")
For Each w In p
If Not r.Find(What:=w, LookAt:=xlPart) Is Nothing Then
c.Characters(Start:=InStr(s, w), Length:=Len(w)).Font.Color = vbRed
End If
Next w
next
End Sub

[#6]

@peiyezhu thanks so much for looking at this for me, but I can't seem to get it to work are you able to have a look at in my spreadsheet see attached and let me know what I am doing wrong? Really appreciate your help :) 

[#7]

@Tenielle 

Your code has

    With Worksheets("Ingredience_List")

but the name of the sheet is Ingredience List with a space instead of an underscore.

So it should be

    With Worksheets("Ingredience List")

Similarly, you should use "Online Product Sheets" instead of "Online_Product_Sheets".

And the comma-separated lists of ingredients are in column K of Online Product Sheets, not in column J, as far as I can tell. However there isn't a single match with column A of the Ingredience List sheet, at least not in your sample workbook.

Try this version:

Sub Button1_Click()
    Dim r As Range
    Dim c As Range
    Dim s As String
    Dim p() As String
    Dim w As Variant
    With Worksheets("Ingredience List")
        Set r = .Range(.Range("A4"), .Range("A" & .Rows.Count).End(xlUp))
    End With
    For Each c In Sheets("Online Product Sheets").Range("K7:K100")
        c.Font.ColorIndex = xlColorIndexAutomatic
        s = c.Value
        p = Split(s, ", ")
        For Each w In p
            If Not r.Find(What:=w, LookAt:=xlPart) Is Nothing Then
                c.Characters(Start:=InStr(s, w), Length:=Len(w)).Font.Color = vbRed
            End If
        Next w
    Next c
End Sub

[#8]

It works!!! thank you so much and have a Happy holiday :)