Move these two lines AFTER the Loop statement

ActiveCell.Offset(1, 0).Range("A1").Select
Selection.EntireRow.Insert


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
' '
'i = i + 1
'Loop

ActiveCell.Offset(1, 0).Range("A1").Select
' Selection.EntireRow.Insert


HTH


"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