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

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

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

I'm not quite sure what you want cuz I would put at the top but this code
will find the word "total" and insert a row just before that row.

Sub findtotal()
x = Columns(1).Find("total").Row
Rows(x).Insert
End Sub

this does the same
Sub findtotal1()
Rows(Columns(1).Find("total").Row).Insert
End Sub
--
Don Guillett
SalesAid Software

"SharonInGa" wrote in message
...
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