VBA Copy and Delete Rows loop optimisation

Question

I'm trying to identify which cells in Column C in a spreadsheet of data are dates and if they are, then check if that date is older than 2 years old. If the second condition is met then the below code should copy the entire row from sheet "DUP_ALL" to a new sheet (Archive) and then delete the copied row from the "DUP_ALL" sheet.

I believe it works but I was wondering if there are any better ways to optimise my code.

Is it more efficient to stay in the first loop and copy and delete the rows at the same time or is it better to copy all the rows, then loop through a second time deleting all the rows that meet the same criteria.

I tried doing a copy and then delete in the same for loop to begin with but it kept producing an error "Run Time 1004: Method 'Range' of Object '_worksheet' failed"

Any help with optimising the below is greatly appreciated

Sub TestArchive()
Dim sh As Worksheet, lr As Long, rng As Range, sh2 As Worksheet, lr2 As Long, c As Range
Set sh = Sheets("DUP_ALL") 'Edit sheet name
Set sh2 = Sheets("Archive") 'Edit Sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("C2:C" & lr)

For Each c In rng
    If IsDate(c.Value) Then
        If c.Value < Date - 456 Then
            lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            c.EntireRow.Copy sh2.Range("A" & lr2)
            End If
        End If
    Next
For Each c In rng
    If IsDate(c.Value) Then
        If c.Value < Date - 456 Then
            lr1 = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
            c.EntireRow.Delete sh.Range("A" & lr1)
            End If
        End If
    Next
End Sub

Answer 1

I've found that if you are deleting rows in a range you need to create a for loop that starts at the bottom and works your way up. When you are using the for each loop and try deleting an item out of that range and keep looping it destroys the reference to that range. The next iteration will throw an error.

Here's an example, (I'm just pulling this out of my head and haven't tested it, but it should get you in the right direction)

...
dim sh1Rows as integer  
dim myCell as range  

sh1Rows = sh.["A1"].end(xlDown).row

for i = sh1Rows to 1 step -1
    set myCell = sh["A1"].offset(0,i)
    if IsDate(myCell.value) and myCell.value < Date - 456 Then
        sh2.cells(1,sh2.["A1"].end(xlDown) +1).entirerow = myCell.entirerow.value
        myCell.entirerow.delete
    end if
next