Delete rows sub very slow to process

Question

I built a macro in Excel that stores input from multiple input tabs into a database (table format). As part of the macro I included a Sub to delete any previous entries for a given year (CYear) before writing new entries for that year.

This was working fine until the size of the workbook increased to about 10MB. The following part of the code now takes >1 hour to run. Is there any other method which might be faster?

Application.ScreenUpdating = False and Application.Calculation = xlCalculationManual are included as part of the larger Sub, r will approach some thousands of rows.

Dim r As Long
Sheets("Database").Activate

For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

    If Cells(r, "G") = Range("C5") Then
        ActiveSheet.Rows(r).EntireRow.Delete
    End If
Next

Answer 1

Deleting something in a Worksheet is a rather slow operation, and depending on how many rows you want to delete (and it seems to be a lot), you should collect everything that should be deleted in a Range-Variable and delete it all at once.

One additional aspect is that UsedRange is not always reliable, and if you are unlucky, the macro checks everything from the very last possible row (=1048576), which could also be an issue. The construct .Cells(.Rows.Count, "G").End(xlUp).row will get the row number of the last used row in Col 'G'.

Try the following code

Sub del()

    Dim r As Long
    Dim deleteRange As Range
    Set deleteRange = Nothing

    With ThisWorkbook.Sheets(1)
        For r = .Cells(.Rows.Count, "G").End(xlUp).row To 1 Step -1
            If .Cells(r, "G") = .Range("C5") Then
                If deleteRange Is Nothing Then
                    Set deleteRange = .Cells(r, "G")
                Else
                    Set deleteRange = Union(deleteRange, .Cells(r, "G"))
                End If
            End If
        Next
    End With

    If Not deleteRange Is Nothing Then
        deleteRange.EntireRow.Delete
    End If
End Sub

Answer 2

Hey bob I found that when you work with thousands of rows or hundreds of thousands you may want to try arrays. They are insanely fast to do the same as you would on the sheet

Try this:

Sub DeleteRows()

    Dim arr, arr1, yeartocheck As Integer, yearchecked As Integer, ws As Worksheet, i As Long, j As Long, x As Long

    Set ws = ThisWorkbook.Sheets("DataBase")
    yeartocheck = ws.Range("C5")

    arr = ws.UsedRange.Value 'the whole sheet allocated on memory

    ReDim arr1(1 To UBound(arr), 1 To UBound(arr, 2)) 'lets define another array as big as the first one

    For i = 1 To UBound(arr1, 2) 'headers for the final array
        arr1(1, i) = arr(1, i)
    Next i

    x = 2 'here starts the data on the final array (1 is for the headers)

    For i = 2 To UBound(arr) 'loop the first array looking to match your condition
        yearchecked = arr(i, 7)
        If yearchecked <> yeartocheck Then 'if they don't match, the macro will store that row on the final array
            For j = 1 To UBound(arr, 2)
                arr1(x, j) = arr(i, j)
            Next j
            x = x + 1 'if we store a new row, we need to up the x
        End If
    Next i

    With ws
        .UsedRange.ClearContents 'clear what you have
        .Range("A1", .Cells(UBound(arr1), UBound(arr, 2))).Value = arr1 'fill the sheet with all the data without the CYear
    End With


End Sub