Delete rows sub very slow to process - excel

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