Give this a whirl... It is more efficient and only adds the one row below the
total... I thought we already did this once? No pivot tables right...

Public Sub InsertRowAfterTotal()
Dim rngFound As Range
Dim rngToSearch As Range
Dim wksCurrent As Worksheet
Dim strFirstAddress As String

Set wksCurrent = ActiveSheet
Set rngToSearch = wksCurrent.Range("A1").EntireColumn
Set rngFound = rngToSearch.Find("Total", LookIn:=xlFormulas)

If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
Do
rngFound.Offset(1, 0).EntireRow.Insert
Set rngFound = rngToSearch.FindNext(rngFound)
Loop While rngFound.Address < strFirstAddress
End If
End Sub

"SharonInGa" wrote:

I want to insert one row after finding a subtotal. The code below is
inserting five rows. ????
'-------------------------------------
Dim i As Integer
'i = 1
'Do Until IsEmpty(Cells(i, 1))
' Cells.Find(What:="Total", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
' :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext,
MatchCase:= _
' False, SearchFormat:=False).Activate
' ActiveCell.Offset(1, 0).Range("A1").Select
' Selection.EntireRow.Insert
'
'i = i + 1
'Loop