To the OP. This code will overwrite some of your data ( if I understand
your the situation) and the activecell is in column A when you run it.

Test it on a copy of your data. (always good advice)
--
Regards,
Tom Ogilvy

"Greg Wilson" wrote in message
...
Use Test2 if there are potentially blanks in the range else use Test:

Sub Test()
Dim r As Range, c As Range
Set r = Range(ActiveCell, ActiveCell.End(xlDown))
Application.ScreenUpdating = False
For Each c In r.Cells
If InStr(c.Value, ActiveCell.Value) 0 Then _
c(1, 2).Value = ActiveCell.Value
Next
Application.ScreenUpdating = True
End Sub

Sub Test2()
Dim r As Range, c As Range
Dim col As Long
col = ActiveCell.Column
Set r = Range(ActiveCell, Cells(Rows.Count, col).End(xlUp))
Application.ScreenUpdating = False
For Each c In r.Cells
If InStr(c.Value, ActiveCell.Value) 0 Then _
c(1, 2).Value = ActiveCell.Value
Next
Application.ScreenUpdating = True
End Sub

Regards,
Greg


"Jim Jackson" wrote:

In a spreadsheet I have one column with single item names and a second
column
with strings of data. I am trying to set up a routine that will search
the
column with strings for the names found in the first one. The result
needed
is to place the name in a third column adjacent to the one with the
string
that contains the name. I have come up with this:

If InStr(Range("B2"), ActiveCell) Then Range("C2") = ActiveCell
If InStr(Range("B3"), ActiveCell) Then Range("C2") = ActiveCell
etc.

This works if I use "Offset" and type a separate line of code for each
row
of data but this is rather inconvenient since there are over 1000 rows.

Is there a better way to accomplish this?

Thanks for any help anyone may offer.