I have a problem as per the subject line.
The problem region of code is listed below.
The actual error is occurring at this point of execution in the Sub
Next_Bold_Font_Found()


Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True).Activate

The routine works perfectly in that all subtotals are identified and
formatted.
I tried different lists (they're dynamic) to make sure and no problems in
the formatting except for the macro going into a continuous loop.

Sub Format_All_Subtotals()
'
' Finds & Formats The First Transport Company Totals in Bold Case

Application.FindFormat.Font.Bold = True
Range("A50").Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Offset(0, 7).Range("A1:J1").Select
Selection.Font.Bold = True
ActiveCell.Offset(0, -7).Range("A1").Select
Application.Run "Test_Next_Cell_Down"

End Sub

Sub Next_Bold_Font_Found()
'
'Finds & Formats The Remaining Transport Company Totals in Bold Case

Application.FindFormat.Font.Bold = True
ActiveCell.Offset(1, 0).Select
Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Offset(0, 7).Range("A1:K1").Select
Selection.Font.Bold = True
ActiveCell.Offset(0, -7).Range("A1").Select
ActiveCell.Offset(1, 0).Select

End Sub

Sub Test_Next_Cell_Down()
'
' Tests that the cell below Is Not Empty

Do
Application.Run "Next_Bold_Font_Found"
Loop While Not IsEmpty(ActiveCell)
Application.Run "Go_Home"
formWhatNext.Show

End Sub

Sorry if the code is as bit long winded, but I'm teaching myself VBA and
learning as I go.
Any help with this post is very much appreciated.
-----
AlecC