Excel vba macro - Loop to format sheet

[EverClear]

Hi there!!</SPAN>
I created a macro to automatically insert subtotals into a report. Now I want to include code that will format each subtotal row (bold, shaded). My idea is to have the macro search for “ Total” as a String and each time it finds that character string, format the row accordingly. So, the macro should loop through the entire spreadsheet, and format every row that contains the string “ Total.”</SPAN>

The issue is that once the macro finds the first occurrence of the string “ Total” it launches into an endless loop, constantly re-formatting just the first occurrence. The macro never advances to any other occurrence of the string so that it can be formatted.</SPAN>

Here is the code I have so far:
</SPAN>
Sub Macro1()</SPAN>
‘</SPAN>
‘</SPAN>
'</SPAN>
Const gWORD As String = " Total"</SPAN>
Dim found As Range</SPAN>
'</SPAN>
Set found = ActiveSheet.Cells.Find( _</SPAN>
what:=gWORD, _</SPAN>
LookIn:=xlValues, _</SPAN>
LookAt:=xlPart, _</SPAN>
MatchCase:=False)</SPAN>

If Not found Is Nothing Then</SPAN>
Do</SPAN>
found.Select</SPAN>
With ActiveCell</SPAN>
Range(Cells(.Row, "A"), Cells(.Row, "Z")).Select</SPAN>
End With</SPAN>
With Selection.Interior</SPAN>
.Pattern = xlSolid</SPAN>
.PatternColorIndex = xlAutomatic</SPAN>
.ThemeColor = xlThemeColorAccent1</SPAN>
.TintAndShade = 0.799981688894314</SPAN>
.PatternTintAndShade = 0</SPAN>
End With</SPAN>

Set found = ActiveSheet.Cells.FindNext</SPAN>

Loop Until found Is Nothing</SPAN>

End If</SPAN>

End Sub

How can I get this code to advance the search to the next occurrence of the string?? HELP!!

 

[starl]

VBA help has a *great example*. Search for Range.Find method. Here's their example:

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues) 'first search
    If Not c Is Nothing Then 
        firstAddress = c.Address 'store the first hits address
        Do 'do your action
            c.Value = 5
            Set c = .FindNext(c) 'run the find again
        Loop While Not c Is Nothing And c.Address <> firstAddress 'until nothing is found or you hit the first address again
    End If
End With

basically, you need to store the cell address of the first hit. then you loop through the sheet until you hit the first address again.

 

[EverClear]

It works!! AWESOME!! Thanks starl!