Loop until Sum equals Zero ($0.00) - then Insert Row

[Jim May]

Below are only rows 147 - 154 (No of Rows will vary) (from Beginning at Row
5 - always)

A B C D
E F
2/28/06 101 Deposit Accts Rec 101001
2,430.00
2/28/06 101 Deposit Accts Rec
120001 -1,000,00
2/28/06 101 Deposit Accts Rec
120001 -1,000.00
2/28/06 101 Deposit Accts Rec
120001 - 430.00
2/28/06 101 Deposit Accts Rec 101001
53,496.26
2/28/06 101 Deposit Accts Rec
120001 -53,496.26
2/28/06 101 Deposit Accts Rec 101001
38,495.25
2/28/06 101 Deposit Accts Rec
120001 -38,495.25

I need to insert a BLANK ROW between all SELF-BALANCING Rows to have look
like:

A B C D
E F
2/28/06 101 Deposit Accts Rec 101001
2,430.00
2/28/06 101 Deposit Accts Rec
120001 -1,000,00
2/28/06 101 Deposit Accts Rec
120001 -1,000.00
2/28/06 101 Deposit Accts Rec
120001 - 430.00

2/28/06 101 Deposit Accts Rec 101001
53,496.26
2/28/06 101 Deposit Accts Rec
120001 -53,496.26

2/28/06 101 Deposit Accts Rec 101001
38,495.25
2/28/06 101 Deposit Accts Rec
120001 -38,495.25

But how?

TIA,,,

 

[Norman Jones]

Hi Jim,

Try:

Public Sub Tester002()
Dim WB As Workbook
Dim SH As Worksheet
Dim rng As Range
Dim i As Long
Dim LRow As Long
Dim CalcMode As Long
Dim ViewMode As Long
Const FRow As Long = 5

Set WB = Workbooks("Your Workbook.xls") '<<=== CHANGE
Set SH = WB.Worksheets("Sheet1") '<<=== CHANGE

On Error GoTo XIT

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveWindow
ViewMode = .View
.View = xlNormalView
End With

SH.DisplayPageBreaks = False

LRow = SH.Cells(Rows.Count, "F").End(xlUp).Row

For i = LRow To FRow Step -1
Set rng = Cells(i, "F")
With rng
If .Value = -.Offset(-1).Value Then
.Offset(-1).EntireRow.Insert
End If
End With
Next i

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

ActiveWindow.View = ViewMode

End Sub
'<<=============