Removing Subtotals with a value of Zero and related data

[SAMCRO2014]

I have a macro to remove all subtotals that equal zero along with the data making up the total; however it appears to be deleting more data than it should.

For example, I know the outstanding total should be $157,542 but when I run the macro to remove the zero subtotals my outstanding balance changes to $156,606.

I can't understand what I am doing wrong. There are no blank cells or cells that contain zeros in the data that create the subtotal.

Sub Remove_Zer_SubTotals()


'Set Variables
Dim Ar As Areas
Dim Rng As Range

Dim Previous As Worksheet
Set OST = ThisWorkbook.Sheets("OS Transactions")


'Turn off printing and screen updating to speed up macro
With Application
.ScreenUpdating = False
.PrintCommunication = False
End With

'Delete all subtotals with a zero balance and associated data above the subtotal

Set Ar = Range("O2", Range("O" & Rows.Count).End(xlUp)).SpecialCells(xlConstants).Areas
For Each Rng In Ar
If Round(Rng.Offset(Rng.Count).Resize(1).Value, 0) = 0 Then Rng.Resize(Rng.Count + 1).EntireRow.Delete
Next Rng

'Turn on printing and screen updating to speed up macro
With Application
.ScreenUpdating = True
.PrintCommunication = True
End With

' Have message box appear to know the macro has completed running
MsgBox "Done!!!"

End Sub

Can you help me?

 

[SAMCRO2014]

Bump

 

[Fluff]

I can't see anything obviously wrong with the code.
Roughly how many subtotals are you deleting?
Also check that after deleting blocks of data your remaining formulae are still looking at the correct ranges.

 

[SAMCRO2014]

I am deleting several hundred subtotals. Ok. I will check the remaining formulae. Thanks!

 

[Fluff]

As you are using "Round" you may get some discrepancies in the before & after total.
If you do it like this, it will tell you the value of the cells you are deleting

Dim Tot As Double
For Each rng In Ar
If Round(rng.Offset(rng.Count).Resize(1).Value, 0) = 0 Then
   Tot = Tot + rng.Offset(rng.Count).Resize(1).Value
   rng.Resize(rng.Count + 1).EntireRow.Delete
End If
Next rng
MsgBox Tot

 

[SAMCRO2014]

Perfect. I will give it a try!