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,

 

[awoohaw]

Maybe turn off screen updating before the delete and back on after
Application.ScreenUpdating = False
If Not visibleRows Is Nothing Then visibleRows.EntireRow.Delete
Application.ScreenUpdating = True

 

[nniedzielski]

Maybe turn off screen updating before the delete and back on after
Application.ScreenUpdating = False
If Not visibleRows Is Nothing Then visibleRows.EntireRow.Delete
Application.ScreenUpdating = True

I should have mentioned, i am already doing that, at the beginning of the sub:
screenUpdating
displayAlerts
enableEvents

are all switched off

 

[awoohaw]

Okay, my expertise on performance ends there. Others will chime in.

 

[Peter_SSs]

This should be much faster. I have assumed ..

• Currently the worksheet in question will not be filtered before the code is run.
• The FALSE values in column N are Text "FALSE" values and not Logical TRUE/FALSE values

If any part of my assumptions is incorrect then post back with details.
Test with a copy of your data.

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
      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.ScreenUpdating = True
    End If
  End With
End Sub

 

[kvsrinivasamurthy]

Try this code on a copy of your file.

Application.DisplayAlerts = False
 With Ws.Range("N1")
 .AutoFilter Field:=14, Criteria1:="<>False"
 Sheets.Add.Name = "New"
    With .CurrentRegion
    .Copy Sheets("New").Range("A1")
    .AutoFilter
    .Clear
 Sheets("New").Range("A1").CurrentRegion.Copy .Range("A1")
 Sheets("New").Delete
 End With
Application.DisplayAlerts = True

 

[johnnyL]

The following is what I came up with which should be really quick:

Sub Test()
'
    Dim ArrayRow                As Long
    Dim NextEmptyColumnNumber   As Long
    Dim NumberOfRowsToDelete    As Long
    Dim FalseColumnArray        As Variant
    Dim HelperColumnArray       As Variant
    Dim ws                      As Worksheet
'
    Set ws = Sheets("Sheet1")
'
    NextEmptyColumnNumber = ws.Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1  ' Get NextEmptyColumnNumber
'
    FalseColumnArray = ws.Range("N1:N" & ws.Range("N" & ws.Rows.Count).End(xlUp).Row)                                                       '
    ReDim HelperColumnArray(1 To UBound(FalseColumnArray), 1 To 1)                                                                          '
'
    NumberOfRowsToDelete = 0                                                                                                                ' Reset NumberOfRowsToDelete
'
    For ArrayRow = 1 To UBound(FalseColumnArray, 1)                                                                                         ' Loop thru rows of SumColumnArray
        If FalseColumnArray(ArrayRow, 1) = "False" Then                                                                                     '   If the value is found then ...
            NumberOfRowsToDelete = NumberOfRowsToDelete + 1                                                                                 '       Increment NumberOfRowsToDelete
            HelperColumnArray(ArrayRow, 1) = 1                                                                                              '       Set row in HelperColumnArray = 1
        End If
    Next                                                                                                                                    ' Loop back
'
    If NumberOfRowsToDelete > 0 Then                                                                                                        ' If there are rows to be deleted then ...
        With ws.Range("A1").Resize(UBound(FalseColumnArray), NextEmptyColumnNumber)                                                         '   Set range for possible deletion of rows
            .Columns(NextEmptyColumnNumber).Value = HelperColumnArray                                                                       '       Write the HelperColumnArray to the EmptyColumn
            .Sort Key1:=.Columns(NextEmptyColumnNumber), Order1:=xlAscending, Header:=xlNo                                                  '       Sort the Rows with '1's to the top
            .Resize(NumberOfRowsToDelete).EntireRow.Delete                                                                                  '       Delete the rows with '1's all at once
        End With
    End If
End Sub

 

[Peter_SSs]

The following is what I came up with which should be really quick:

I agree it should be really quick. Looks extremely similar to post #5!

 

[johnnyL]

Similar indeed, now that I look at the two.

 

[nniedzielski]

This should be much faster. I have assumed ..

• Currently the worksheet in question will not be filtered before the code is run.
• The FALSE values in column N are Text "FALSE" values and not Logical TRUE/FALSE values

If any part of my assumptions is incorrect then post back with details.
Test with a copy of your data.

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
      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.ScreenUpdating = True
    End If
  End With
End Sub

this was much faster, thank you!!