Macro to delete Zero values is slow

howard

Well-known Member
Joined
Jun 26, 2006
Messages
6,561
Office Version
  1. 2021
Platform
  1. Windows
I have a workbook + -37000 rows of Data (Cols A:W)

I have the following macro , but it runs for a long time and seems to be going into a loop so I closed it down through the task manager

I want to delete all rows where there is zero value in both Col T & U (for eg if T2 is zero and U2 is zero the row must be deleted)


Code:
 Sub Delete_Zeroes()
Sheets("Sheet1").Select
Dim lr As Long, i As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
    If Range("T" & i).Value = 0 And Range("U" & i).Value = 0 Then
        Range("T" & i).EntireRow.Delete
    End If
Next i
End Sub
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
An autofilter macro should be faster. But try this
Code:
Sub Delete_Zeroes()
    Dim lr As Long, I As Long
    With Worksheets("Sheet1")
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        For I = lr To 1 Step -1
            If .Range("T" & I).Value = 0 And .Range("U" & I).Value = 0 Then
                .Range("T" & I).EntireRow.Delete
            End If
        Next I
    End With
End Sub

Your loop needs to start from the lastrow to the firstrow and not the other way round
 
Upvote 0
Hi,
see if this update to your code is any quicker for you:

Code:
Sub Delete_Zeroes()
    Dim c As Range, DeleteRange As Range
    Dim DataRange As Range
   
    'change sheet name as required
    With Worksheets("Sheet1")
        Set DataRange = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With


    DataRange.EntireRow.Hidden = False


    For Each c In DataRange.Cells
        If c.Offset(0, 19).Value = 0 And c.Offset(0, 20).Value = 0 Then
            If DeleteRange Is Nothing Then
                Set DeleteRange = c
            Else
                Set DeleteRange = Union(DeleteRange, c)
            End If
        End If
    Next c
    'delete all matched rows in one go
    If Not DeleteRange Is Nothing Then DeleteRange.EntireRow.Delete
End Sub

Dave
 
Upvote 0
Thanks for your input

I have tried your code, but still slow. Will use an autofilter to select zeroes and then delete the rows containing zeroes
 
Upvote 0
Hi Dave

Thanks for the help. Your code is much faster
 
Upvote 0
An autofilter example
Code:
Sub AutofilterMacro()
    With ActiveSheet
        lr = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A1:U" & lr).AutoFilter Field:=20, Criteria1:="0"
        .Range("A1:U" & lr).AutoFilter Field:=21, Criteria1:="0"
        .Range("A2:U" & lr).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
        .Range("A2:U" & lr).AutoFilter
    End With
End Sub

Took about 29seconds on 52000 rows :) fair enough
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

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
Back
Top