This will fiind duplicates and will not supplant the contents in the third
row. For example, for the following scenario:

A4 = "Jackson"
A10 = "County"
A15 = "Frank"
A17 = "Hen"
A20 = "Arch"

All other cells in column A populated with text not found in column B.

B2 = "Franklin and Henderson Architechs"
B6 = "Jacksonville County"
B9 = "Mike Jackson"

Result:

C2 = "Frank" and "Hen" and "Arch" in the same cell
C6 = "Jackson" and "County" in the same cell
C9 = "Jackson"

If the text of more than one cell in column A is found in the same cell in
column B then these multiple hits will be displayed in the adjacent cell in
column C in separate lines (i.e. wrapped). So the contents of cells in column
C are not supplanted. Also, if the contents of a single cell in column A is
found in more than one cell in column B then these will be displayed in the
adjacent cells in column C.

Run on a copy of your data as Tom mentioned. Hope it's what you were looking
for.

Regards,
Greg

Sub Test()
Dim r As Range, r2 As Range
Dim c As Range, c2 As Range, c3 As Range
Dim wks As Worksheet

Application.ScreenUpdating = False
Set wks = Sheets("Sheet1")
With wks
Set r = .Range(.Cells(2, 1), _
.Cells(2, 1).End(xlDown))
Set r2 = .Range(.Cells(2, 2), _
.Cells(2, 2).End(xlDown))
End With
For Each c In r.Cells
For Each c2 In r2.Cells
If c2 Like "*" & c & "*" Then
Set c3 = c2(1, 2)
If Len(c3) = 0 Then c3 = c _
Else c3 = c3 & Chr(10) & c
End If
Next c2
Next c
Application.ScreenUpdating = True
End Sub


"Pops Jackson" wrote:

I had stated that I found duplicate matches but found that not to be true.
In fact, I have learned that I need to find duplicate matches, so that the
cell showing the results will be filled in for each occurence of the match.
I have tried making changes to the routine but with no success.

How can I change the routine to find each occurence instead of the first it
comes across?

Thanks,

Jim
--
Pops Jackson


"Tom Ogilvy" wrote:

Sub bbb()
Dim rngA As Range, rngB As Range
Dim rng As Range, cell As Range
Dim res As Variant
With Worksheets("Sheet1")
Set rngA = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
Set rngB = .Range(.Cells(2, 2), .Cells(2, 2).End(xlDown))
End With
For Each cell In rngA
res = Application.Match("*" & cell.Value & "*", rngB, 0)
If Not IsError(res) Then
Set rng = rngB(res)
rng.Offset(0, 1).Value = cell
End If
Next

End Sub

worked for me. It assumes the lists start in A2 and B2. If in A1 and B1,
change

With Worksheets("Sheet1")
Set rngA = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown))
Set rngB = .Range(.Cells(1, 2), .Cells(1, 2).End(xlDown))
End With

--
Regards,
Tom Ogilvy

"Jim Jackson" wrote in message
...
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.