Text search only finds 1st result

[Felixdecat]

Hello, I have written the following code. The purpose is to find every
instance of a word in the worksheet, and then highlight it yellow. However,
it only finds the 1st instance, but does not carry on searching the rest of
the worksheet. Can anyone help me? The first part of the code clears the
previous search results.

Private Sub CommandButton1_Click()

Dim Wsht As Worksheet
Dim Rng As Range
Dim cl As Range
For Each Wsht In Worksheets
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
Next Wsht

Set Rng = Nothing
Set cl = Nothing

w = InputBox("Please enter a Word")

Cells.Find(What:=(w), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End Sub

 

[OssieMac]

Because you are clearing the interior color index on all the worksheets I
have assumed that you also want to search all worksheets. I have included the
clear and set the color index in the one loop.

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")

For Each Wsht In Worksheets

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

Next Wsht

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

End Sub

 

[Dave Peterson]

You write worksheet (most people mean a single worksheet), but then you loop
through all the worksheets in the active workbook.

I'm gonna guess that you really wanted to loop through all the worksheets in
that workbook and find that string:

Option Explicit
Private Sub CommandButton1_Click()

Dim Wks As Worksheet
Dim myWord As String
Dim FoundCell As Range
Dim FirstAddress As String

myWord = InputBox("Please enter a Word")
If Trim(myWord) = "" Then
Exit Sub 'user hit cancel
End If

For Each Wks In Worksheets
Set FoundCell = Nothing
FirstAddress = ""
With Wks
'do the entire usedrange at once.
.UsedRange.Interior.ColorIndex = xlNone

Set FoundCell = .Cells.Find(what:=myWord, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If FoundCell Is Nothing Then
'not on this sheet
Else
FirstAddress = FoundCell.Address

Do
'do the work
With FoundCell.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

'look for more
Set FoundCell = .Cells.FindNext(after:=FoundCell)

If FoundCell Is Nothing Then
'this shouldn't happen
Exit Do
End If

If FoundCell.Address = FirstAddress Then
'back to the first cell, so exit the loop
Exit Do
End If
Loop
End If
End With
Next Wks
End Sub

 

[Felixdecat]

Thanks a lot OssieMac!! That works great!

I did actually only want to do this for 1 worksheet. I cut and paste the
code for the colouring, so forgot to edit it for 1 worksheet only.

How do I change your code so it only applies to 1 sheet only?

Thanks again!

 

[OssieMac]

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

 

[Felixdecat]

That is great OssieMac. Thank you very much for your help! I appreciate the
time you have taken to help me.

 

[Felixdecat]

Thanks for taking the time to responsed Dave. It is amazing how many
different ways you can achieve the same thing in Excel.