Delete Subtotal Groups that Equal 0

[SAMCRO2014]

I have search the forum and found coding on how to delete subtotal groups that equal 0 and have tried a few with no success. I must be missing something.

My subtotals are added for each change in column F and it is subtotalling amounts in Column M. I haveover 460K lines of data.I started deleted them manually but it will take forever.

DelZeroBlocks()
Dim c As Range
Dim cf As String

For Each c In Range("M2", Range("M" & Rows.Count).End(xlUp) _
.Offset(-1)).SpecialCells(xlCellTypeFormulas)
If c.Value = 0 Then
cf = c.Formula
Union(c, Range(Replace(Mid(cf, 13, Len(cf)), ")", ""))).EntireRow.Delete
End If
Next c
End Sub

 

[Fluff]

How about

Sub DelZeroBlocks()
   Dim Ar As Areas
   Dim Rng As Range
   
   Set Ar = Range("M2", Range("M" & Rows.count).End(xlUp)).SpecialCells(xlConstants).Areas
   For Each Rng In Ar
      If Rng.Offset(Rng.count).Resize(1).Value = 0 Then Rng.Resize(Rng.count + 1).EntireRow.Delete
   Next Rng
End Sub

This assumes that the values in Col M are not formulae with the exception of the subtotal rows

 

[SAMCRO2014]

Unfortunately, it did not work. I will keep playing with code to see if I can figure it out.

 

[Fluff]

In what way "didn't it work"

 

[SAMCRO2014]

It did not delete any subtotals that equalled zero and the transactions that made up that balance.

 

[Fluff]

Are you sure that the value is 0 rather than 0.00001 or something similar?

 

[SAMCRO2014]

Looking closer you are correct. I have several amount that add up to amounts such as 1.81898940354586E-12 but the subtotal shows 0. How can I account for this?

 

[Fluff]

Try

Sub DelZeroBlocks()
   Dim Ar As Areas
   Dim Rng As Range
   
   Set Ar = Range("M2", Range("M" & 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
End Sub

 

[SAMCRO2014]

That worked!!! THANK YOU!!! THANK YOU!!! THANK YOU!!!

 

[Fluff]

Glad to help & thanks for the feedback