View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
OssieMac OssieMac is offline
external usenet poster
 
Posts: 2,510
Default Text search only finds 1st result

The following clears the formatting on only the activesheet then applies the
formatting to only the activesheet.

See further info below for an alternative method if you want the code to
work on other worksheets that you select.

Private Sub CommandButton1_Click()

Dim Wsht As Worksheet
Dim Rng As Range
Dim cl As Range
Dim rngFind As Range
Dim firstAddress As String
Dim w As String

w = InputBox("Please enter a Word")

Set Wsht = ActiveSheet

Set Rng = Wsht.UsedRange
For Each cl In Rng
With cl
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = 0
End If
End With
Next cl

With Rng
Set rngFind = .Find(What:=(w), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFind Is Nothing Then
firstAddress = rngFind.Address
Do
rngFind.Interior.ColorIndex = 6
Set rngFind = .FindNext(rngFind)

Loop While Not rngFind Is Nothing _
And rngFind.Address < firstAddress

End If
End With

Set Rng = Nothing
Set cl = Nothing
Set rngFind = Nothing

End Sub



If you want to you could place the main processing code in a standard module
and then on each worksheet you can have a command button with just the code
to call the sub. that way it will work on whatever is the activesheet.

Put a command button on the worksheet and the following code in the
worksheet module.
Private Sub CommandButton1_Click()
Call ApplyFormating
End Sub


Put the following code in a standard module.
Sub ApplyFormating()

Dim Wsht As Worksheet
Dim Rng As Range
Dim cl As Range
Dim rngFind As Range
Dim firstAddress As String
Dim w As String

w = InputBox("Please enter a Word")

Set Wsht = ActiveSheet

Set Rng = Wsht.UsedRange
For Each cl In Rng
With cl
If .Interior.ColorIndex = 6 Then
.Interior.ColorIndex = 0
End If
End With
Next cl

With Rng
Set rngFind = .Find(What:=(w), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rngFind Is Nothing Then
firstAddress = rngFind.Address
Do
rngFind.Interior.ColorIndex = 6
Set rngFind = .FindNext(rngFind)

Loop While Not rngFind Is Nothing _
And rngFind.Address < firstAddress

End If
End With

Set Rng = Nothing
Set cl = Nothing
Set rngFind = Nothing
End Sub


--
Regards,

OssieMac