Deleting rows based on a variable in 1 column

[forensic93]

hello,

I have created some code that will delete an entire row based on if the value 1 is in the column or not.
The code works but takes 40 minutes to run on 300,000 lines.

Is there a better method to make this work?

Sub Delete_Rows()
Dim i As Long
Dim LastRow As Long

Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row

For i = LastRow To 2 Step -1
    If Cells(i, "E") < "1" Then Rows(i).EntireRow.Delete
Next i

Application.ScreenUpdating = True

End Sub

 

[nemmi69]

Seems good t me

 

[Peter_SSs]

If Cells(i, "E") < "1" Then Rows(i).EntireRow.Delete

Can you clarify exactly what is in column E (numbers or text) and what should trigger the row to be deleted. The above code line is not too clear to me.

 

[forensic93]

Can you clarify exactly what is in column E (numbers or text) and what should trigger the row to be deleted. The above code line is not too clear to me.

Hi Peter,

In column E is just 1's and 0's, so i was trying to write code which would look for something smaller then 1 and if it was true then delete the entire row.

 

[Peter_SSs]

In column E is just 1's and 0's

OK, I'll assume they are numerical values. Wasn't quite sure because your original code uses the string notation "1" rather than just the number 1.
Anyway, see how this goes for accuracy and speed compared to your 40 minutes.

Sub Del_0_From_E()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, CalcState As Long
  
  With ActiveSheet
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = Range("E2", Range("E" & 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
        k = k + 1
        b(i, 1) = 1
      End If
    Next i
    If k > 0 Then
      With Application
        CalcState = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
      End With
      With .Range("A2").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      With Application
        .Calculation = CalcState
        .EnableEvents = True
        .ScreenUpdating = True
      End With
    End If
  End With
  MsgBox "Done"
End Sub

 

[forensic93]

Anyway, see how this goes for accuracy and speed compared to your 40 minutes.

Thanks Peter! That worked a lot faster! Can you explain what the difference is? are you putting it into an array before performing the loop?

 

[Peter_SSs]

You're welcome.

BTW, I'm interested in approx how long it took with your real data?

Yes, my code reads the column E data into an array then goes through that array and if the value is 0, it puts a 1 in that position in a new array. At the end it writes that new array at the right of all your existing data, sorts the whole data so all the "1" values (rows to be deleted) are together (all the other rows remain in the same order as they were before) and then deletes them in one go.

Interaction between code and a worksheet is (relatively) slow and my code only interacts with the sheet a few times (blue above). For 300,000 rows, your original code interacts with the sheet between 300,000 and 600,000 times, hence the slow speed.

 

[forensic93]

BTW, I'm interested in approx how long it took with your real data?

It took 2 minutes which is much faster then my 40 minutes haha
And thank you for explaining that to me, i'm still trying to get my head around vba

 

[Peter_SSs]

OK, thanks for the extra info.