Faster way to delete rows with 0 value

[Jayus03]

Hi All,

I have over 200,000 rows of data in excel, with value in column D, I am currently using a macro to delete all rows with zero value in column D, but it is taking forever to finish (20+ minutes and still going), is there a way to make it run faster?

Sub Testin()


varCalcMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


SrcRange = Sheets("Sheet1").Range("D2", Range("D2").End(xlDown)).Select
With Selection
Selection.NumberFormat = "0"
.Value = .Value
End With


Dim myloop
For myloop = Range("D2").End(xlDown).Row To 1 Step -1
If Cells(myloop, 4).Value = 0 Then Rows(myloop).EntireRow.Delete
Next myloop
' need to revise to trim down on run time
MsgBox "Finished"


End Sub

Thank you!

 

[sheetspread]

You can replace all zeroes with blanks or a 1/0 error then let the specialcells method highlight them for deletion.

 

[Eric W]

To expand a bit on sheetspread's comment, here's a macro that replaces zeros (and blanks) with #DIV/0! errors, then uses the SpecialCells method to delete them. Since this is an internal function to Excel, it runs very fast.

Sub DeleteRows()

    With Range("D2", Cells(Rows.Count, "D").End(xlUp))
        .Value = Evaluate(Replace("IF(@="""",1/(1/@),1/(1/@))", "@", .Address))
        .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    End With
        
End Sub

 

[Jayus03]

Got it, thanks for the help!

 

[Eric W]

Glad we could help.

 

[Peter_SSs]

Although you have a vast improvement, if you are looking for speed, you might also consider the following code.
With 100,000 rows of data, of which about 5% contained zeros, Eric's code took about 20 seconds on my machine.
For identical data, this code took 0.37 seconds.

Sub Del_Zero()
  Dim a, b
  Dim nc As Long, i As Long
 
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("D1", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = 0 Then b(i, 1) = 1
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(UBound(a), nc)
    .Columns(nc).Value = b
    .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    On Error Resume Next
    .Columns(nc).SpecialCells(xlConstants).EntireRow.Delete
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
End Sub

 

[Fishboy]

Although you have a vast improvement, if you are looking for speed, you might also consider the following code.
With 100,000 rows of data, of which about 5% contained zeros, Eric's code took about 20 seconds on my machine.
For identical data, this code took 0.37 seconds.

Sub Del_Zero()
  Dim a, b
  Dim nc As Long, i As Long
 
  nc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, _
                SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("D1", Range("D" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = 0 Then b(i, 1) = 1
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(UBound(a), nc)
    .Columns(nc).Value = b
    .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    On Error Resume Next
    .Columns(nc).SpecialCells(xlConstants).EntireRow.Delete
    On Error GoTo 0
  End With
  Application.ScreenUpdating = True
End Sub

That is pretty amazing Peter!

Can you explain the logic behind what it is doing please?

 

[Peter_SSs]

That is pretty amazing Peter!

Can you explain the logic behind what it is doing please?

Sure.

1. Find an empty column to the right fo the sheet's data, see step 5.
2. Load the column of data into an array in memory.
3. Make a new empty array the same size.
4. Work through each value in the original array and if zero, place a 1 in the corresponding position of the new array. Working in memory is much faster than interactions between code and the worksheet.
5. Write the new array values into the empty column found at step 1. This places a 1 in every row that needs to be deleted.
6. Sort the whole sheet based on this new column. This collects all the rows to be deleted together, whilst keeping the remaining rows in the original order. Whilst sorting is a relatively slow process, getting the rows to be deleted together in a single group to then be deleted more than compensates. Deleting lots of disjoint rows can be very slow.
7. Delete all the rows that have a 1 in the new column. As outlined in the previous point, this is now just one single block of rows. After the deletion, there is nothing left in the new column so there is no tidying up needed in that column.

 

[Fishboy]

Sure.

1. Find an empty column to the right fo the sheet's data, see step 5.
2. Load the column of data into an array in memory.
3. Make a new empty array the same size.
4. Work through each value in the original array and if zero, place a 1 in the corresponding position of the new array. Working in memory is much faster than interactions between code and the worksheet.
5. Write the new array values into the empty column found at step 1. This places a 1 in every row that needs to be deleted.
6. Sort the whole sheet based on this new column. This collects all the rows to be deleted together, whilst keeping the remaining rows in the original order. Whilst sorting is a relatively slow process, getting the rows to be deleted together in a single group to then be deleted more than compensates. Deleting lots of disjoint rows can be very slow.
7. Delete all the rows that have a 1 in the new column. As outlined in the previous point, this is now just one single block of rows. After the deletion, there is nothing left in the new column so there is no tidying up needed in that column.

Genius!

Thanks Peter

 

[Peter_SSs]

Genius!

Thanks Peter

No problem, but I'm not the genius as I didn't think up the method, just copied it from somewhere else - don't know where.