Filter Efficiency

[nniedzielski]

Hello-

I have two separate sections of code doing some filtering, and i was wondering if I could combine them into one?

This section is lightning fast, and i want to keep it:

'delete all "False" rows, quick version
    Dim a As Variant, b As Variant
    Dim nc As Long, k As Long
 
    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
        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
      End If
    End With

This section is taking forever, and i was wondering if it could be combined into the above code to do it all at once quickly:

    With ws.Range("C1:C" & lastRow)
        .AutoFilter field:=1, Criteria1:="Yes"
        Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        rng.EntireRow.Delete
        .AutoFilter
    End With

any help is always appreciated,

 

[Peter_SSs]

Try the below adaptation of my code from your earlier thread.

BTW, that code had a couple of slight errors in it. I will post revised code and explanation in that older thread shortly.

Sub Del_Text_FALSE_Yes()
  Dim ws As Worksheet
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, lr As Long
  
  Set ws = ActiveSheet '<- or whatever sheet you want
  With ws
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lr = .Columns("C:N").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    a = Application.Index(.Cells, Evaluate("row(2:" & lr & ")"), Array(3, 14))
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If UCase(a(i, 1)) = "YES" Or UCase(a(i, 2)) = "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