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

 

[WarPigl3t]

Sub myMacro()
     myInput = InputBox("Enter a name.") 'John
     firstColumn = 1
     lastColumn = Cells(4, Columns.Count).End(xlToLeft).Column
     c = firstColumn
     Do Until c > lastColumn
          If LCase(Trim(Cells(4, c).Value)) <> LCase(Trim(myInput)) 
               Columns(c).Delete
               c = c - 1
          End If
          c = c + 1
     Loop
End Sub

 

[Jonmo1]

If you reverse the logic of the filter (filter for NOT = John)
Then you can delete all the visible rows in one line without a loop

Something like

Sub FilterandDelete()
Dim lr As Long, i As Long, rngData As Range

lr = Worksheets("Backlog").Range("A" & Rows.Count).End(xlUp).Row
i = Application.Match("Leader", Worksheets("Backlog").Range("A4:JD4"), 0)
Set rngData = Worksheets("Backlog").Range("A4:JD" & lr)

rngData.AutoFilter Field:=i, Criteria1:="<>John"
rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EnitireRow.Delete
rngData.AutoFilter

Application.Calculation = xlCalculationAutomatic
End Sub

 

[Faintkitara]

Thank you. I ran it and it gives me an error at the offset line (first because i think entire was misspelled and then again saying "you cannot use that command on overlapping sections")... I forgot to mention that my filters are on row 4

 

[Jonmo1]

Good catch on the mispelling, that's what I get for not testing code...

I also changed up how the last row is found, now basing it on the column found by the match function.
Try

Sub FilterandDelete()
Dim lr As Long, i As Long, rngData As Range

i = Application.Match("Leader", Worksheets("Backlog").Range("A4:JD4"), 0)
lr = Worksheets("Backlog").Cells(Rows.Count, i).End(xlUp).Row
Set rngData = Worksheets("Backlog").Range("A4:JD" & lr)

rngData.AutoFilter Field:=i, Criteria1:="<>John"
rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
rngData.AutoFilter

Application.Calculation = xlCalculationAutomatic
End Sub

 

[Faintkitara]

@WarPigl3t I got an error on the If Lcase line saying that there was a syntax error...

 

[WarPigl3t]

I forgot the "Then" Statement.
If something Then
do something
End if

 

[Faintkitara]

Getting error "1004: Can not use on overlapping selections" on the same offset line. Not sure what that means but I will be researching it as well.

More info:

headers are on rows 1-4
"Leader" header in column N

Thank you for your assistance though

 

[Jonmo1]

Are the correct rows at least being filtered ?
i.e. you end up with only rows that <>John Visible ?

Change this line
rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
to
rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Select

Do the correct rows get selected ?

 

[Faintkitara]

@WarPigl3t excel kinda froze on me

@Jonmo1 Yes it does select the correct rows!