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]

If excel froze, it means too much code was running. This means that it never exited the loop. Why would you think it would not exit the loop? Maybe you misspelled John? Did it delete anything? Try running the code line by line using the F10 key on your keyboard instead of pushing the Run button.

 

[Jonmo1]

Ok, so only when deleting the rows does it error...
Strange, I have no thoughts on why that wouldn't work. I'll ask around.

 

[WarPigl3t]

If LCase(Trim(Cells(4, c).Value)) <> LCase(Trim(myInput)) _
And Cells(4, c).Value <> "" Then

 

[WarPigl3t]

Forget that last post. It would be pointless since the original if statement would account for blanks. The error might be in Columns(c).Delete
Try Column(c).Delete

 

[Faintkitara]

@WarPigl3t When I do that it errors on Columns(C). Delete... is it trying to delete columns because I only want to delete rows...

@Jonmo1 Thank you for the effort, I will do some digging as well.

 

[WarPigl3t]

If you are trying to delete rows, then I misunderstood your original post.

 

[RoryA]

Does this work:

rngData.Offset(1).Resize(rngData.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

?

 

[Rick Rothstein]

If none of the above work for you, then does this completely different approach work...

[table="width: 500"]
[tr]
	[td]Sub FilterAndDelete()
  Dim LastRow As Long, UnusedCol As Long, LeaderCol As Long, KeepMe As String
  Const HeaderRow As Long = 4
  KeepMe = "John"
  LeaderCol = Rows(HeaderRow).Find("Leader", , , xlWhole, , , False).Column
  LastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  UnusedCol = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
  Application.ScreenUpdating = False
  Range(Cells(HeaderRow + 1, UnusedCol), Cells(LastRow, UnusedCol)) = Evaluate("IF(H5:H28=""" & KeepMe & ""","""",1)")
  Application.Calculation = xlCalculationManual
  Columns(UnusedCol).SpecialCells(xlConstants).EntireRow.Delete
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[Jonmo1]

I also wonder if restricting the Deletion to the used columns instead of the entire row..

Try changing this

rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

To

Application.Intersect(Range("A:JD"), rngData.Offset(1).Resize(rngData.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow).Delete

 

[slinky]

When doing this previously, I found a massive speed impact was the deletion of non-contiguous rows as, after each row deletion, Excel needs to shuffle the remaining rows below.
On that basis, I marked rows for deletion by placing an character in another column, then sorted and filtered and deleted as one block.

edited to add some code...

rcount = Selection.Rows.CountrTotal = rcount


Range("D2").Select
TimeStart = Timer
Do Until rcount = 0


    CheckRef = Findit(Right(ActiveCell.Value, 5), "B:B")
    If FoundValue = "" Then
        ActiveCell.Offset(0, 17).Value = "D"
    Else


        CheckRef = Findit(ActiveCell.Offset(0, 7).Value, "D:D")
        If FoundValue = "" Then
            ActiveCell.Offset(0, 17).Value = "D"
            GoTo Finish
        Else
        End If
    ActiveCell.Value = Right(ActiveCell.Value, 5)
    
    End If
    
Finish:
    ActiveCell.Offset(1, 0).Select
    rcount = rcount - 1
Loop


    Selection.AutoFilter Field:=21, Criteria1:="D", Operator:=xlAnd
Range("A2:A" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Selection.AutoFilter