Sub SearchPT()
Dim str As String
Dim fCell As Range
Dim R As Range, rng as Range
Dim fAddr as String
Set R = Worksheets("Sheet1").Range("A:A")
str = InputBox("Enter Product")
Set fCell = R.Find(What:=str & "*", _
After:=R.Cells(R.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If fCell Is Nothing Then
MsgBox "Can't find product"
Exit Sub
else
fAddr = fcell.address
do
if rng is nothing then
set rng = fcell
else
set rng = union(rng,fcell)
end if
set fcell = R.FindNext(fcell)
loop while fcell.Address < fAddr
End If
if not rng is nothing then
rng.Select
msgbox rng.Address
end if
End Sub

--
Regards,
Tom Ogilvy


"Richard Hocking" wrote:

Hello,

I'm using the following code to search for data within a column. It's
working fine, but it only finds the first occurrence of the search term, when
often there may be 4 or 5 in the whole column. Can anyone tell me the extra
bit of code I need to enable me to keep searching until the end of the column
(eg a column of data from A1:A100)?

Sub SearchPT()
Dim str As String
Dim fCell As Range
Dim R As Range
Set R = Worksheets("Sheet1").Range("A:A")
str = InputBox("Enter Product")
Set fCell = R.Find(What:=str & "*", _
After:=R.Cells(R.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If fCell Is Nothing Then
MsgBox "Can't find product"
Exit Sub
End If
fCell.Activate
End Sub

Thanks for any help!

Richard.