Faster code to delete cells through multiple worksheets in excel

Question

i am a beginner in VB and having googled and looked through the answers here i have written the following loop to cycle through multiple excel worksheets and delete rows where the cells contain specific elements (N/A # N/A#).

The data in the xl sheet to be cleaned is financial data with DATE, OPEN. HIGH LOW CLOSE. the number of rows can be significant and the number of worksheets can be 2-300. It works but is very very slow and as I am learning - would appreciate any assistance on how i can make this code faster. Thank you.

    Sub DataDeleteStage1()

    ScreenUpdating = False

      Dim lrow As Long
      Dim ws As Worksheet
      Dim icntr As Long


       For Each ws In ThisWorkbook.Worksheets

                lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row
                For icntr = lrow To 1 Step -1

                If ws.Name <> "HEADER" Then
                If ws.Cells(icntr, "B") = "#N/A N/A" And ws.Cells(icntr, "C") = "#N/A N/A" And ws.Cells(icntr, "D") = "#N/A N/A" And ws.Cells(icntr, "E") = "#N/A N/A" Then
                            ws.Rows(icntr).EntireRow.Delete
                End If
                End If

                Next icntr

        Next ws

    End Sub

Try adding `Application.ScreenUpdating = False` before your `For Loop` and `Application.ScreenUpdating = True` at the end of your `For Loop`. — , Oct 24 '17 at 12:42
For speed, avoid a loop alltogether and delete based on a filtered range. Have a look over this [Ozgrid page](https://www.ozgrid.com/VBA/VBALoops.htm) — Rik Sportel, Oct 24 '17 at 12:44
@DavidG. - the OP has it on his 2. line. I was thinking of offering the same :) — Vityata, Oct 24 '17 at 12:46
To optmize, try to use autofilter with an array multi criteria and delete the rows on a single task. Or if you don't want to use filter, you can make a non contiguous range and delete all at once later. Because the most time consuming action in your code, is every time you perform actions on your worksheet, in your case when you delete. And refer to [this](http://www.cpearson.com/excel/optimize.htm), [this](https://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less) and [this](https://stackoverflow.com/q/46077673/7690982) — danieltakeshi, Oct 24 '17 at 13:16

score 2 · Accepted Answer · answered Oct 24 '17 at 12:46

Try merging all Ranges to be deleted to a MergeRng object, and then just delete it all at once.

Code

Sub DataDeleteStage1()

ScreenUpdating = False

Dim lrow As Long
Dim ws As Worksheet
Dim icntr As Long
Dim MergeRng As Range

For Each ws In ThisWorkbook.Worksheets
    With ws
        lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For icntr = lrow To 1 Step -1
            If .Name <> "HEADER" Then
                If .Cells(icntr, "B") = "#N/A N/A" And .Cells(icntr, "C") = "#N/A N/A" And .Cells(icntr, "D") = "#N/A N/A" And .Cells(icntr, "E") = "#N/A N/A" Then
                    If Not MergeRng Is Nothing Then
                        Set MergeRng = Application.Union(MergeRng, .Rows(icntr))
                    Else
                        Set MergeRng = .Rows(icntr)
                    End If
                End If
            End If
        Next icntr

        ' Delete all rows at once
         If Not MergeRng Is Nothing Then MergeRng.Delete
    End With

    Set MergeRng = Nothing ' reset range when changing worksheets

Next ws

End Sub

Vityata · Answer 2 · 2017-10-24T12:57:36.653

1

You can make your code delete only once and not every time. In order to make it like this, try the following:

Sub DataDeleteStage1()

    Application.ScreenUpdating = False

    Dim lrow        As Long
    Dim ws          As Worksheet
    Dim icntr       As Long

    Dim delRange    As Range

    For Each ws In ThisWorkbook.Worksheets

        lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row
        For icntr = lrow To 1 Step -1
            If ws.Name <> "HEADER" Then
                If ws.Cells(icntr, "B") = "#N/A N/A" And _
                    ws.Cells(icntr, "C") = "#N/A N/A" And _
                    ws.Cells(icntr, "D") = "#N/A N/A" And _
                    ws.Cells(icntr, "E") = "#N/A N/A" Then

                    If Not delRange Is Nothing Then
                        Set delRange = ws.Rows(icntr)
                    Else
                        Set delRange = Union(delRange, ws.Rows(icntr))
                    End If
                End If
            End If
        Next icntr

        If Not delRange Is Nothing Then delRange.Delete
        Set delRange = Nothing

    Next ws
End Sub

I have not tried it, but it should work.

edited Oct 24 '17 at 12:57

answered Oct 24 '17 at 12:42

Vityata

42,633
8
55
100

1

Damn, how did you beat me to it ? I just answered a similar post 2-3 days ago, I had the code ready. – Shai Rado Oct 24 '17 at 12:47
Still looping, so not a huge optimization. Also there's a loop over the worksheets, so this code will crash on the `Union` when the Ranges are in two different sheets. (`Method 'Union' of object '_Global' failed`) - You could do 1 deletion per Worksheet. Still using `autofilter` and `ScreenUpdating = False` will perform a lot better. – Rik Sportel Oct 24 '17 at 12:47
@RikSportel - You are right,but the optimization in time is probably 95%, the deletion is what takes the time. And indeed, the `Union` will break, but this is good, because the OP needs an indication, if by any chance he is taking data from two worksheets. – Vityata Oct 24 '17 at 12:50
@ShaiRado - giving my best :) – Vityata Oct 24 '17 at 12:51
@Vityata however, I am reseting the `MergeRng` when changing worksheets inside the loop – Shai Rado Oct 24 '17 at 12:51
@ShaiRado - yup, that should be done, did not notice the multiple sheets. – Vityata Oct 24 '17 at 12:58
@RikSportel - I see what you mean with the broken Union now. Fixed it. – Vityata Oct 24 '17 at 12:58

Imran Malek · Answer 3 · 2017-10-24T13:14:35.807

I haven't tested but try this,

Sub DataDeleteStage1()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim lrow As Long
    Dim ws As Worksheet
    Dim icntr As Long

    For Each ws In ThisWorkbook.Worksheets

        lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row

        If ws.Name <> "HEADER" Then
        On Error Resume Next
            Range("F1:F" & lrow).Formula = "=IF(SUMPRODUCT(--ISERROR(A1:E1))=5,NA(),"""")"
            Range("F1:F" & lrow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp
            Range("F1:F" & lrow).Clear

        End If

    Next ws

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

score 0 · Answer 4 · answered Oct 24 '17 at 12:58

0

How about this?

Sub DeleteRows()
Dim ws As Worksheet
With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "HEADER" Then
        On Error Resume Next
        ws.Columns("B:E").Replace "#N/A N/A", "=NA()"
        ws.Columns("B:E").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
    End If
Next ws
With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

answered Oct 24 '17 at 12:58

Subodh Tiwari sktneer

9,906
2
18
22

1

Nice and elegant and performs slightly faster than the Autofilter approach. - However, based on the question you need to delete only the rows where all values hold the error. – Rik Sportel Oct 24 '17 at 13:13
@RikSportel Thanks for the feedback. Good catch, I didn't notice that. :) – Subodh Tiwari sktneer Oct 24 '17 at 13:15

score 0 · Answer 5 · answered Oct 24 '17 at 13:10

With AutoFilter and without looping altogether:

Sub DataDeleteStage1()
Dim ws As Worksheet
Dim lr As Integer
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    With ws
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        If ws.Name <> "HEADER" Then
            .UsedRange.AutoFilter Field:=2, Criteria1:="#N/A"
            .UsedRange.AutoFilter Field:=3, Criteria1:="#N/A"
            .UsedRange.AutoFilter Field:=4, Criteria1:="#N/A"
            .UsedRange.AutoFilter Field:=5, Criteria1:="#N/A"
            .Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete shift:=xlUp
        End If
    End With
Next ws
Application.ScreenUpdating = True
End Sub

Tested this vs. the merged range approach on 300K rows - faster by minutes when doing multiple sheets.

Thanks Rik - this makes it easier as I need to add when all fields are Zeros as well. So i have adjusted your code to .UsedRange.AutoFilter Field:=2, Criteria1:="#N/A", Operator:=xlor, Criteria2:="=0" — ChyG, Oct 24 '17 at 13:31
@ChyG cheers. There are some limitations to `AutoFilter` with multiple criteria though, but there's extensive Q&A here on SO about that. — Rik Sportel, Oct 24 '17 at 13:52

Faster code to delete cells through multiple worksheets in excel

5 Answers5