VBA Code:
Sub test()
Dim c As Range, FoundCells As Range
Dim c1 As Range
Dim firstaddress As String
Application.ScreenUpdating = False
With Sheets("Sheet1")
'find first cell that contains "rec"
Set c = .Cells.Find(What:="rec", After:=.Cells(Rows.Count, 1), LookIn:=xlValues, LookAt:= _
xlPart, MatchCase:=False)
'if the search returns a cell
If Not c Is Nothing Then
'note the address of first cell found
firstaddress = c.Address
Set c1 = Cells(c.Row + 0, c.Column - 1).Address
Do
'FoundCells is the variable that will refer to all of the
'cells that are returned in the search
If FoundCells Is Nothing Then
Set FoundCells = c
Else
Set FoundCells = Union(c, FoundCells)
End If
'find the next instance of "rec"
Set c = .Cells.FindNext(c)
Loop While Not c Is Nothing And firstaddress <> c.Address
'after entire sheet searched, select all found cells
MsgBox FoundCells.Address
Else
'if no cells were found in search, display msg
MsgBox "No cells found."
End If
End With
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: