Microsoft Excel - Delete Rows with a column subtotal value of 0

Asked By Jason on 14-Jan-11 06:36 PM

Forgive me for my lack of experience with VBA.  I am trying to do the best I can with google and common sense.  So I've created a macro that ends up subtotaling data, going to the second level of subtotals, and then deletes all rows with an amount balance of 0.  However my problem is that my current macro looks at all data and deletes the row if the amount balance of 0.    I want the macro to go into subtotal level 2 and delete all rows with 0.  That way only lines with a amount balance subtotal of 0 will get deleted and not just any line that has an amount balance of 0.  This is the code of my current macro.

Range("A5").Select
    Selection.Subtotal GroupBy:=23, Function:=xlSum, TotalList:=Array(56), _
    Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim lastrow As Long, r As Long
   lastrow = ActiveSheet.UsedRange.Rows.Count
   For r = lastrow To 1 Step -1
    If UCase(Cells(r, 56).Value) = "0" Then Rows(r).Delete
   Next r
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True

I either need it to go to level 2, filter amount balance to only show amount balance subtotals of 0 and then delete any rows that are on the screen or go to level 2 and delete any rows with an amount balance of 0.  One of the problems I've also run into is that the data doesn't start until row 5.  Row 4 is column headers.  Also when looking at level 2 of subtotals the first line of data is not row 5 but row 8 for example because that is where the first subtotal is located.  The amount balance column is column 56 by the way.  Any ideas?



Btw here is an example of what i'm talking about:


 Level 2:


A Total  0

B Total  20

C Total  30


Level 3(expanded level 2):


A    0

A    0

A Total   0

B    20

B    0

B Total  20

C   10

C   20

C   0

C Total  30



I would want it to delete both rows of A and no other rows.  Even though one row of B and C have an amount balance of 0, their subtotal is not 0 so I do not want to delete any of their rows.  Thus I would want the macro to simply look at level 2 and delete the row A Total.

Jackpot . replied to Jason on 14-Jan-11 11:41 PM
Hi Jason

Why dont you post your file with some sample data highlighting the rows to be deleted.
Jason replied to Jackpot . on 17-Jan-11 11:05 AM
K here should be a decent example.  I also ran into another problem recently that maybe you can help me address.  In that file all of the red cells should be delete and all of the green cells should be kept. However my current macro is deleting both the red and the green.  You have to look at the data in the 2nd and 3rd level of the outline to see what I am talking about and why the problem occurs.  The other problem that I recently ran into is that when deleting the data in level 2.  It does not delete correctly because it leaves behind lines of data that should have been deleted.  Apparently you need to expand the data inorder to delete everything that you are trying.  So I'm thinking for the macro, the only way to correctly delete all of the data would be to go into level 2, filter for 0 amount balance, and then expand back to level 3 and delete all.  Hope this helps.
Jason replied to Jackpot . on 17-Jan-11 11:06 AM
Example for Website2.zip. Sorry here is the file.
Jackpot . replied to Jason on 17-Jan-11 11:37 AM

Hi Jason

Try this macro on the active sheet.


Sub DeleteRows()
Dim lngRow As Long, lngTRow As Long
  
For lngRow = Cells(Rows.Count, "E").End(xlUp).Row To 4 Step -1
If Trim(Range("E" & lngRow)) Like "* Total" Or lngRow = 4 Then
If lngTRow <> 0 Then Rows(lngRow + 1 & ":" & lngTRow).Delete
  If Range("S" & lngRow).Value = 0 Then
  lngTRow = lngRow
  Else
  lngTRow = 0
  End If
End If
Next
End Sub
Jason replied to Jackpot . on 17-Jan-11 12:07 PM
I'm not sure what I am doing wrong but nothing happens when I run that macro on the real files.  When I run it in the example I gave you it deletes every row.  I tried running it while i was in both level 2 and 3 of the outline. I feel like I am probably overlooking something very basic.
Jackpot . replied to Jason on 17-Jan-11 12:09 PM
Check out the columns tosee whether it is same as the sample file posted...If not change the code to suit....
Jason replied to Jackpot . on 17-Jan-11 12:39 PM
From what I can tell it worked perfectly.  Thank you very much.
Jason replied to Jackpot . on 28-Jan-11 09:27 AM
Ok so I hate to reopen a solved case but after using my macro on several different large documents that the removing subtotals of 0 part of the macro took way too long.  With several thousands of lines of data I was wondering if there was another solution that would maybe be quicker? Manually sorting by the Amount Balance column and deleting the 0's takes only a few seconds. I was wondering if there was a way that you could get a macro to do the same process or any process that would decrease the execution time? I was also thinking about creating a macro to create a pivot table to remove the subtotals of 0.  Again thank you for the code you already provided me, it worked flawlessly on all of the documents I've used it on so far.
Jackpot . replied to Jason on 28-Jan-11 08:15 PM
Try Disabling the screen updating..



Sub DeleteRows()
Dim lngRow As Long, lngTRow As Long
Application.ScreenUpdating = False  
For lngRow = Cells(Rows.Count, "E").End(xlUp).Row To 4 Step -1
If Trim(Range("E" & lngRow)) Like "* Total" Or lngRow = 4 Then
If lngTRow <> 0 Then Rows(lngRow + 1 & ":" & lngTRow).Delete
  If Range("S" & lngRow).Value = 0 Then
  lngTRow = lngRow
  Else
  lngTRow = 0
  End If
End If
Next
Application.ScreenUpdating = True
End Sub