delete rows in multiple sheets if value in certain column is zero

[dutchdscooper]

I need code to delete rows in 16 different sheets if the cell value in column F is zero. The headers are all on row 2 so data starts on row 3. The data ranges for each tab are always changing and never the same so need special range coding to identify where the data range ends (column A can be used to determine when the range has ended).

Also, I'm hoping the macro can run quickly and smoothly. I have attempted a bunch of different codes but all either don't function properly after the first sheet, take longer than it would for me to filter to zeros and delete manually (some sheets have thousands of rows of data and certain code was literally going line by line taking forever on 1 sheet much less 16 sheets).

Your assistance is greatly appreciated!

 

[lrobbo314]

Hi! Welcome to the forum.

How about this?

Sub Delete_F_Zero()
Dim wb As Workbook
Dim ws As Worksheet
Dim LR As Long
Dim i As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        LR = ws.Range("F" & Rows.Count).End(xlUp).Row()
            For i = LR To 2 Step -1
                If ws.Cells(i, 6) = 0 Then
                    ws.Rows(i).EntireRow.Delete
                End If
            Next i
    Next ws
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
        
End Sub

 

[vcoolio]

Hello Dutchdscooper,

If you have large and varying data sets in each sheet, it may be worthwhile sorting then filtering the data prior to deleting entire rows. This method should only take a second or two to execute. Hence try the following code:-

Option Explicit
Sub DeleteZeroes()
          Dim ws As Worksheet
          Dim lr As Long
          
Application.ScreenUpdating = False
For Each ws In Worksheets
            ws.Range("A3", ws.Range("F" & ws.Rows.Count).End(xlUp)).Sort ws.[F3], 1
               ws.Range("F2", ws.Range("F" & ws.Rows.Count).End(xlUp)).AutoFilter 1, 0
                 lr = Range("A" & Rows.Count).End(xlUp).Row
                  If lr > 1 Then
                    ws.Range("F3", ws.Range("F" & ws.Rows.Count).End(xlUp)).EntireRow.Delete
                      End If
                ws.[F2].AutoFilter
       Next ws
Application.ScreenUpdating = True
End Sub

I've assumed that the criteria in Column F are all numerical. The code sorts on Column F ascending.

I hope that this helps.

Cheerio,
vcoolio.

Edit: As your data starts in row 3, change this line in the code:-

If lr > 1 Then

to

If lr > 2 Then

 

[dutchdscooper]

I appreciate your help and immediate response on this! I forgot to mention one small thing...there are other sheets in the workbook that need to be excluded. Where and what can I input to exclude specific names of worksheets? Thanks again for your help!

Hi! Welcome to the forum.

How about this?

Sub Delete_F_Zero()
Dim wb As Workbook
Dim ws As Worksheet
Dim LR As Long
Dim i As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        LR = ws.Range("F" & Rows.Count).End(xlUp).Row()
            For i = LR To 2 Step -1
                If ws.Cells(i, 6) = 0 Then
                    ws.Rows(i).EntireRow.Delete
                End If
            Next i
    Next ws
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
        
End Sub

 

[dutchdscooper]

I appreciate your help and immediate response on this! I forgot to mention one small thing...there are other sheets in the workbook that need to be excluded. Where and what can I input to exclude specific names of worksheets? Thanks again for your help!

 

[lrobbo314]

Here is one way to do it.

Sub Delete_F_Zero()
Dim wb As Workbook
Dim ws As Worksheet
Dim LR As Long
Dim i As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

kList = getWsList
Set wb = ActiveWorkbook

    For Each ws In wb.Worksheets
        For k = 1 To UBound(kList)
            If ws.Name = kList(k) Then
                LR = ws.Range("F" & Rows.Count).End(xlUp).Row()
                    For i = LR To 2 Step -1
                        If ws.Cells(i, 6) = 0 Then
                            ws.Rows(i).EntireRow.Delete
                        End If
                    Next i
            End If
        Next k
    Next ws
    
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
        
End Sub

Function getWsList() As Variant
Dim ws As Worksheet 'Sheet with list of sheet names to have rows deleted
Dim r As Range 'Range where sheet names are
Dim i As Integer
Dim AR() As Variant

Set ws = Sheets("Sheet1") 'Change sheet name to your list
Set r = ws.Range("M1:M3") 'Range of cells with sheet names

    For i = 1 To r.Cells.Count
        ReDim Preserve AR(1 To i)
        AR(i) = r.Cells(i).Value
    Next i
    
getWsList = AR()
End Function

You could also hard code the sheet names into the array in the code itself, but this should do the trick.