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

 

[excel-proficient]

Hi,

This may be something you are looking for:

Sub DeleteZeroTotals()
     
    Set aaa = ActiveSheet
    
    
     
    lEndRow = aaa.Range("E" & aaa.Rows.Count).End(xlUp).Row
     
    On Error Resume Next
StartAgain:
    bolFound = False
    For Each rng In aaa.Range("d2:d" & lEndRow).SpecialCells(xlCellTypeBlanks)
        If rng.Offset(0, 1) > -1 And rng.Offset(0, 1) < 1 Then
            If rng.Row > 3 Then
                If rng.End(xlUp).End(xlUp).Row > 1 Then
                    aaa.Range(rng, rng.End(xlUp).End(xlUp)).EntireRow.Delete
                     
                Else
                    aaa.Range(rng, rng.End(xlUp).End(xlUp).Offset(1, 0)).EntireRow.Delete
                End If
                bolFound = True
            Else
                aaa.Range(rng, rng.End(xlUp)).EntireRow.Delete
                bolFound = True
            End If
             
        End If
    Next rng
     
    lEndRow = aaa.Range("E" & aaa.Rows.Count).End(xlUp).Row
    If bolFound = True Then GoTo StartAgain
     
     
End Sub

 

[Peter_SSs]

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

Francisco

Welcome to the MrExcel board!

Can you give us some more detail about your subtotalled data?

1. Does it start in cell A1? If not, where?

2. Does it have a fixed number of columns? How many?

3. Which of these columns do we have to check for zero subtotals?

 

[Weaver]

This is not particularly sophisiticated, so I'd try it on a sample of data first. It assumes the values and subtotals are in column A and the whole row should be deleted. It also assumes the first row is a header.

Sub test()
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        Set rng = Cells(r, "A")
        cf = rng.Formula
        cv = rng.Value
        If InStr(cf, "SUBTOTAL") And cv = 0 Then
            addr = Mid(cf, InStr(cf, ",") + 1, Len(cf))
            addr = Left(addr, InStr(addr, ")") - 1)
            Union(Range(addr), rng).EntireRow.Delete
        End If
    Next
End Sub

HTH

 

[Francisco]

Francisco

Welcome to the MrExcel board!

Can you give us some more detail about your subtotalled data?

1. Does it start in cell A1? If not, where?

2. Does it have a fixed number of columns? How many?

3. Which of these columns do we have to check for zero subtotals?

Peter:

Thanks for your post.

Here are my answers:

1. The first subtotal is found in cell X2.

2. Table has a fixed number of columns. 40 columns

3. Column X contains the subtotals to be checked.

Thanks again

Francisco

 

[Francisco]

This is not particularly sophisiticated, so I'd try it on a sample of data first. It assumes the values and subtotals are in column A and the whole row should be deleted. It also assumes the first row is a header.

Sub test()
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    For r = lr To 2 Step -1
        Set rng = Cells(r, "A")
        cf = rng.Formula
        cv = rng.Value
        If InStr(cf, "SUBTOTAL") And cv = 0 Then
            addr = Mid(cf, InStr(cf, ",") + 1, Len(cf))
            addr = Left(addr, InStr(addr, ")") - 1)
            Union(Range(addr), rng).EntireRow.Delete
        End If
    Next
End Sub

HTH

Weaver:

You're a star.
Thanks so much for the code. It worked perfectly.
An excellent, non sophisticated approach that will allow me to improve the account reconciliation process.

Best Regards

Francisco

 

[Peter_SSs]

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:

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DelZeroBlocks()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <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">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>        <SPAN style="color:#00007F">If</SPAN> c.Value = 0 <SPAN style="color:#00007F">Then</SPAN><br>            cf = c.Formula<br>            Union(c, Range(Replace(Mid(cf, 13, Len(cf)), ")", ""))).EntireRow.Delete<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">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[thatSAMazing]

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.

 

[Weaver]

if you need to check values between +10 and -10 the easiest way is to remove the sign using ABS() and then you can check for <10

If InStr(cf, "SUBTOTAL") And abs(cv) < 10 Then

 

[thatSAMazing]

Thanks so much Weaver. I'll give it a shot at work tomorrow. I'd just like to add that after looking over all these variables and how beautifully this Macro performs, you guys have really inspired me to get into VB.

Thank you.