Macro to delete rows when subtotal = zero

[Francisco]

Dear Excel Community:

Has anyone developed any VBA code to delete rows in a subtotalled list?

The subtotal line and the associated rows should be deleted when subtotal equals zero.

Thanks in advance

Francisco

 

[Peter_SSs]

Thanks so much for the above code. It works great and is the reason I joined this forum actually. Well, that and the fact that I've been watching the fantastic Mr. Excel for years now.

Anyway, I'm hoping someone here can assist in editing the above code so that it will not only delete subtotals that net to 0, but also subtotals that are between -10 and 10.

Thanks very much in advance; you guys are the best!

Thanks again,
Sam.

My previous code would fail in some circumstances. So, still trying to focus just on the formula cells for efficiency, you could test this version (change column to suit your data) in a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DelSubTotalBlocks()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range, del <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> cf <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> del = Range("X1")<br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Range("X2", Range("X" & Rows.Count).End(xlUp) _<br>                .Offset(-1)).SpecialCells(xlCellTypeFormulas)<br>        cf = c.Formula<br>        <SPAN style="color:#00007F">If</SPAN> Left(cf, 10) = "=SUBTOTAL(" And Abs(c.Value) < 10 <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">Set</SPAN> del = Union(del, c, Range(Replace(Mid(cf, 13, Len(cf)), ")", "")))<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> c<br>    <SPAN style="color:#00007F">If</SPAN> del.Count > 1 <SPAN style="color:#00007F">Then</SPAN><br>        Intersect(del, Rows("2:" & Rows.Count)).EntireRow.Delete<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[sreenivas501]

Union(c, Range(Replace(Mid(cf, 13, Len(cf)), ")", ""))).EntireRow.Delete

What is this 13 stands for?...could you pls explain.

I would suggest adding "-1" to the line that calculates lr. This would avoid checking the Grand Total row and therefore avoid the possibility of deleting virtually the whole table if the Grand Total was zero (even though none of the individual subtotals might be zero).

Also, if the original column X data does not contain formulas, the efficiency of the code could be increased by only looking at cells that contain formulas rather than checking every row. In that case an adaptation something like this might be useful:


Sub DelZeroBlocks()
Dim c As Range
Dim cf As String

For Each c In Range("X2", Range("X" & 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