Sub FindHighlight()
Dim tempcell As Range, Found As Range, sTxt, FoundRange As Range, Response As Integer
Set Found = Range("A1")
sTxt = InputBox(prompt:="Enter value for search")
If sTxt = "" Then Exit Sub
Set tempcell = Cells.Find(What:=sTxt, After:=Found, LookIn:=xlValues, lookat:=xlWhole)
If tempcell Is Nothing Then
MsgBox prompt:="Not found"
Exit Sub
Else
Set Found = tempcell
Set FoundRange = Found
End If
Do
Set tempcell = Cells.FindNext(After:=Found)
If Found.Row >= tempcell.Row Then Exit Do
Set Found = tempcell
Set FoundRange = Application.Union(FoundRange, Found)
Loop
FoundRange.Interior.ColorIndex = 6
Response = MsgBox(prompt:="Clear highlighting", Buttons:=vbOKCancel + vbQuestion)
If Response = vbOK Then FoundRange.Interior.ColorIndex = xlNone
End Sub
Sub FindHighlight()
Dim tempcell As Range, Found As Range, sTxt, FoundRange As Range, Response As Integer
[COLOR=red]Dim FirstRow As Long[/COLOR]
[COLOR=red] Dim FirstCol As Long[/COLOR]
Set Found = Range("A1")
sTxt = InputBox(prompt:="Enter value for search")
If sTxt = "" Then Exit Sub
Set tempcell = Cells.Find(What:=sTxt, After:=Found, LookIn:=xlValues, lookat:=xlWhole)
If tempcell Is Nothing Then
MsgBox prompt:="Not found"
Exit Sub
Else
Set Found = tempcell
Set FoundRange = Found
End If
[COLOR=red] FirstRow = Found.Row[/COLOR]
[COLOR=red] FirstCol = Found.Column[/COLOR]
Do
Set tempcell = Cells.FindNext(After:=Found)
[COLOR=red]If tempcell.Row = FirstRow And tempcell.Column = FirstCol Then Exit Do[/COLOR]
Set Found = tempcell
Set FoundRange = Application.Union(FoundRange, Found)
Loop
FoundRange.Interior.ColorIndex = 6
Response = MsgBox(prompt:="Clear highlighting", Buttons:=vbOKCancel + vbQuestion)
If Response = vbOK Then FoundRange.Interior.ColorIndex = xlNone
End Sub