Loop until Sum equals Zero ($0.00) - then Insert Row
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
'<<=============
---
Regards,
Norman
"Jim May" wrote in message
news:pT4Tf.257932$oG.111336@dukeread02...
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,,,
|