# Delete Rows in Subtotal Groups if Subtotal is Zero

#### NicNac123

##### New Member
Hi.

I'm a bit of a novice when it comes to code so I need a bit of help.
I've seen a few threads about this but when I copy the code into my workbook it doesn't work for me.

I've subtotalled my data by PO number to SUM the Amounts in column F. I want all the rows that subtotal zero to be deleted.
FOR EXAMPLE: In the attached image the Subtotal of PO000041113 in cell F10 is zero so I want to delete rows 8, 9 and 10 (or even just rows 8 and 9).

The spreadsheet has 4,000+ rows so I don't want to do this manually!

Thanks in advance.

#### Attachments

• Subtotal Zero Deletion test.JPG
79.7 KB · Views: 17

### Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

#### Domenic

##### MrExcel MVP
The following macro assumes that the sheet containing the data is the active sheet. Note, though, with more than 4,000 rows of data, you'll likely find it somewhat slow.

VBA Code:
``````Option Explicit

Sub RemoveGroupsWithZeroTotals()

Dim last_row As Long
last_row = Cells(Rows.Count, "H").End(xlUp).Row

Dim order_number As String
Dim current_row As Long
Dim delete_rows As Boolean

current_row = last_row
While (current_row > 1)
order_number = Cells(current_row, "H").Value
If order_number <> "Grand Total" And Right(order_number, 5) = "Total" And Cells(current_row, "F").Value = 0 Then
delete_rows = True
While (current_row > 1) And (delete_rows = True)
Rows(current_row).Delete
current_row = current_row - 1
If Right(Cells(current_row, "H"), 5) = "Total" And Cells(current_row, "F").Value <> 0 Then
delete_rows = False
End If
Wend
Else
current_row = current_row - 1
End If
Wend

End Sub``````

Hope this helps!

#### NicNac123

##### New Member
The following macro assumes that the sheet containing the data is the active sheet. Note, though, with more than 4,000 rows of data, you'll likely find it somewhat slow.

VBA Code:
``````Option Explicit

Sub RemoveGroupsWithZeroTotals()

Dim last_row As Long
last_row = Cells(Rows.Count, "H").End(xlUp).Row

Dim order_number As String
Dim current_row As Long
Dim delete_rows As Boolean

current_row = last_row
While (current_row > 1)
order_number = Cells(current_row, "H").Value
If order_number <> "Grand Total" And Right(order_number, 5) = "Total" And Cells(current_row, "F").Value = 0 Then
delete_rows = True
While (current_row > 1) And (delete_rows = True)
Rows(current_row).Delete
current_row = current_row - 1
If Right(Cells(current_row, "H"), 5) = "Total" And Cells(current_row, "F").Value <> 0 Then
delete_rows = False
End If
Wend
Else
current_row = current_row - 1
End If
Wend

End Sub``````

Hope this helps!

Thank you Domenic, this worked perfect! Saved me a lot of time #### Domenic

##### MrExcel MVP
You're very welcome, I'm glad I could help.

Cheers!

ADVERTISEMENT

#### NicNac123

##### New Member
I hav
You're very welcome, I'm glad I could help.

Cheers!

I have no idea how you manage to come up with these codes but it's appreciated.

#### ManiacB

##### Board Regular
Here is another approach, solved it too late but someone might be interested

VBA Code:
``````Sub DelPO()
Dim lr, lrs, x, i, j, ttl, u As Long
Dim ws As Worksheet
Dim Rng, Rngs As Range
Dim wsn As String
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
lr = Cells(Rows.Count, "F").End(xlUp).Row

Set Rng = ws.Range("A1:H" & lr)
'Set RngH = ws.Range("H1:H" & lr)
With ws

For i = lr To 1 Step -1
If InStr((Cells(i, 8)), "Total") = 11 Then GoTo Skip
With Rng
.AutoFilter
'MsgBox Range("H" & (i)).Value
.AutoFilter Field:=8, Criteria1:=Cells(i, "H").Value
'lrs = .SpecialCells(xlCellTypeVisible).Rows.Count
.SpecialCells(xlCellTypeVisible).Copy
wsn = Cells(i, "H").Value
Sheets.Add(After:=Sheets(Sheets.Count)).name = Cells(i, "H").Value
ActiveSheet.Paste
ttl = 0
lrs = Sheets(wsn).Cells(Rows.Count, "H").End(xlUp).Row
For j = lrs To 2 Step -1
Set Rngs = Range("F2:F" & lrs)
ttl = WorksheetFunction.Sum(Rngs)
If ttl = 0 Then
'ws.Cells(i, "I").EntireRow.Delete
ws.Cells(i, "I").Value = "Del"
'MsgBox ttl
End If
Next j

Application.DisplayAlerts = False
ThisWorkbook.Sheets(wsn).Delete
Application.DisplayAlerts = True
End With
Skip:
Next i
' Turn off filter
ws.AutoFilterMode = False

For u = lr To 1 Step -1
If ws.Cells(u, "I").Value = "Del" Or (ws.Cells(u, "F").Value = 0 _
And Right(ws.Cells(u, "H").Value, 5) = "Total") And _
ws.Cells(u, "H").Value <> "Grand Total" Then
ws.Cells(u, "I").EntireRow.Delete
End If
Next u
ws.Activate
End With

Application.ScreenUpdating = True
End Sub``````

#### NicNac123

##### New Member
Here is another approach, solved it too late but someone might be interested

VBA Code:
``````Sub DelPO()
Dim lr, lrs, x, i, j, ttl, u As Long
Dim ws As Worksheet
Dim Rng, Rngs As Range
Dim wsn As String
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
lr = Cells(Rows.Count, "F").End(xlUp).Row

Set Rng = ws.Range("A1:H" & lr)
'Set RngH = ws.Range("H1:H" & lr)
With ws

For i = lr To 1 Step -1
If InStr((Cells(i, 8)), "Total") = 11 Then GoTo Skip
With Rng
.AutoFilter
'MsgBox Range("H" & (i)).Value
.AutoFilter Field:=8, Criteria1:=Cells(i, "H").Value
'lrs = .SpecialCells(xlCellTypeVisible).Rows.Count
.SpecialCells(xlCellTypeVisible).Copy
wsn = Cells(i, "H").Value
Sheets.Add(After:=Sheets(Sheets.Count)).name = Cells(i, "H").Value
ActiveSheet.Paste
ttl = 0
lrs = Sheets(wsn).Cells(Rows.Count, "H").End(xlUp).Row
For j = lrs To 2 Step -1
Set Rngs = Range("F2:F" & lrs)
ttl = WorksheetFunction.Sum(Rngs)
If ttl = 0 Then
'ws.Cells(i, "I").EntireRow.Delete
ws.Cells(i, "I").Value = "Del"
'MsgBox ttl
End If
Next j

Application.DisplayAlerts = False
ThisWorkbook.Sheets(wsn).Delete
Application.DisplayAlerts = True
End With
Skip:
Next i
' Turn off filter
ws.AutoFilterMode = False

For u = lr To 1 Step -1
If ws.Cells(u, "I").Value = "Del" Or (ws.Cells(u, "F").Value = 0 _
And Right(ws.Cells(u, "H").Value, 5) = "Total") And _
ws.Cells(u, "H").Value <> "Grand Total" Then
ws.Cells(u, "I").EntireRow.Delete
End If
Next u
ws.Activate
End With

Application.ScreenUpdating = True
End Sub``````

Hey ManiacB. Thanks so much for your code as well. I've tried this one out as well and works perfectly. Always good to have more than one option • ManiacB

Replies
7
Views
420
Replies
5
Views
138
Replies
1
Views
132
Replies
5
Views
342
Replies
3
Views
128

Threads
1,128,207
Messages
5,629,294
Members
416,384
Latest member
frsamiee

### Share this page ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?    ### Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back