Need to make code faster: delete unfiltered/hidden rows

[Faintkitara]

So I found and manipulated code that Autofilters a specific column by criteria (if name is John) and finally deletes all of the other rows that don't have that name. Seems pretty easy but my code takes an entire 50 seconds to run which is wayyyy to long.

Is there a way to rewrite this code that makes it faster but does the same thing?

Sub FilterandDelete

Dim i As Integer, rngData As Range

Set rngData = Worksheets("Backlog").Range("A4")
i = Application.WorksheetFunction.Match("Leader", Range("A4:JD4"), 0)
rngData.AutoFilter Field:=i, Criteria1:="John"


    Dim lRows As Long
    Application.Calculation = xlCalculationManual
    For lRows = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
        If Cells(lRows, 1).EntireRow.Hidden = True Then Cells(lRows, 1).EntireRow.Delete
    Next lRows
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Faintkitara]

@Rick Rothstein YES thank you! The comments also help immensely, now I know what each command means! Much thanks!

 

[Rick Rothstein]

@Jonmo1 Wow this code is even faster. My code went from 45 seconds to work to like 1 second.. LOL YOU SAVED MY BUTT THANKSSSS.

I know my method will be slower than Jonmo1's code, but I am curious as to how much slower. Could you run the code I posted in Message #29 against the same data set you just ran Jonmo1's code against and tell me how long it took to execute. Thanks.

 

[Faintkitara]

@ Rick Rothstein Your code took a little less than 15 seconds to run.

 

[Jonmo1]

Glad to help, thanks for the feedback.

 

[Rick Rothstein]

@ Rick Rothstein Your code took a little less than 15 seconds to run.

A little longer than I was expecting, but good to know.

Thanks

 

[Peter_SSs]

I'm a bit late to the party here and I understand that you already have a code that you seem happy with. However, if you have data that is more than a few thousand rows, this should be faster again.
For example, with 5,000 rows, about one third of which are "John" this code took less then half the time of the code from post #28.

Sub DelRows()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, r As Long, lr As Long, nc As Long
  
  With Sheets("Backlog")
    lr = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
    nc = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
    i = .Range("A4:JD4").Find(What:="Leader", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False).Column
    a = .Range(.Cells(5, i), .Cells(lr, i)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For r = 1 To UBound(a)
      If LCase(a(r, 1)) <> "john" Then
        b(r, 1) = 1
        k = k + 1
      End If
    Next r
    If k > 0 Then
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual
      With .Range("A5", .Cells(lr, nc))
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom
        .Resize(k).EntireRow.Delete
      End With
      Application.Calculation = xlCalculationAutomatic
      Application.ScreenUpdating = True
    End If
  End With
End Sub

@Rick
I doubt whether the test on your code would have been a fair test anyway as I'm not sure it is actually doing the job required. You have variables for LeaderCol and LastRow, yet in the line below you have hard-coded column H and row 28.
In addition, aren't all the "1"s in the UnusedCol going to be offset by one row since the range being operated on in this code line starts at HeaderRow + 1 but the Evaluate is doing so from Headerrow not HeaderRow + 1?

Range(Cells(HeaderRow + 1, UnusedCol), Cells(LastRow, UnusedCol)) = Evaluate("IF(H" & HeaderRow & ":H28=""" & KeepMe & ""","""",1)")