Finding words

Hi,

I have been trying to find a macro that can search for a list of words that are listed in one tab (name list) and mark them in another, but it doesn't seem to be working. Can anyone help me with this? Thanks a lot for your help


Sub find_name()
Dim name_list As Range, c As Range, d As Range, lookup_list As Range
Worksheets("name list").Activate
Set name_list = Range(Range("A2"), Range("A2").End(xlDown))
Worksheets("Sheet1").Activate
Set lookup_list = Range(Range("A2"), Range("A2").End(xlDown))
For Each c In lookup_list
For Each d In name_list
If InStr(UCase(c.Value), UCase(d.Value)) Then c.Interior.ColorIndex = 6
Next d
Next c
End Sub