Speed up my Code

[nniedzielski]

Hi all-

I am running this section of code, which does a quick filter and deletes all the filtered info, which is round 20k rows. Its running really slow, this section is taking roughly 180 seconds to run. Is there a method that would speed this up at all?

' Filter column N for False
    ws.Range("N1").AutoFilter Field:=14, Criteria1:="False"
    
    ' Delete all visible rows except header row
    lastRow = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row
    
    Dim visibleRows As Range
    Set visibleRows = ws.Range("N2:N" & lastRow).SpecialCells(xlCellTypeVisible)
    If Not visibleRows Is Nothing Then visibleRows.EntireRow.Delete
    
    ' Remove filter
    ws.AutoFilterMode = False

thank you,

 

[nniedzielski]

this was much faster, thank you!!

180 seconds to 21 seconds, just for your information!

 

[Peter_SSs]

180 seconds to 21 seconds, just for your information!

That is a reasonable improvement but I am surprised that it still took 21 seconds. I thought that it would be much faster than that. Do you have a lot of formulas in the worksheet too?
If so, does adding these two lines where shown make any further significant improvement?

    If k > 0 Then
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      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
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End If

 

[kvsrinivasamurthy]

Have a try of post #6.

 

[Peter_SSs]

Have a try of post #6.

I did. It does not compile.

 

[Peter_SSs]

Just to tidy up, my earlier code had a couple of errors in it. Those errors would only be a problem if the sheet from which the rows are being deleted is not the active sheet when the code is run.
The code was missing three "." characters - marked in red in the corrected code below.

Sub Del_Text_FALSE()
  Dim ws As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  Set ws = ActiveSheet '<- or whatever sheet you want
  With ws
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("N2", .Range("N" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If UCase(a(i, 1)) = "FALSE" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      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
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End If
  End With
End Sub