VBA runtime error in Excel VBA "424" Object required when deleting rows

Question

I am trying to compare the values ​​of cells between 2 sheets (Sheet1 and Sheet2) to see if they coincide, and if they match, move the corresponding values ​​in Sheet1 to the pre-existing list (Sheet3) and delete the values ​​in Sheet1 after that.

I use the inverse for a loop in Excel VBA, but everything works until I start deleting a row using newrange1.EntireRow.Delete .

This causes the "424" error required by VBA, and I spent hours trying to solve this problem, I'm not sure why this is happening. Am I choosing the wrong line? An object?

I would appreciate it if someone could point me in the right direction.

Here is my code:

 Sub Step2() Sheets("Sheet1").Activate Dim counter As Long, unsubListCount As Long, z As Long, x As Long, startRow As Long counter = 0 startRow = 2 z = 0 x = 0 ' Count Sheet3 Entries unsubListCount = Worksheets("Sheet3").UsedRange.Rows.Count Dim rng1 As Range, rng2 As Range, cell1 As Range, cell2 As Range, newrange1 As Range ' Select all emails in Sheet1 and Sheet2 (exclude first row) Set rng1 = Worksheets("Sheet1").Range("D1:D" & Worksheets("Sheet1").UsedRange.Rows.Count) Set rng2 = Worksheets("Sheet2").Range("D1:D" & Worksheets("Sheet2").UsedRange.Rows.Count) ' Brute Loop through each Sheet1 row to check with Sheet2 For z = rng1.Count To startRow Step -1 'Cells(z, 4) Set cell1 = Worksheets("Sheet1").Cells(z, "D") For x = rng2.Count To startRow Step -1 Set cell2 = Worksheets("Sheet2").Cells(x, "D") If cell1.Value = cell2.Value Then ' If rng1 and rng2 emails match counter = counter + 1 Set newrange1 = Worksheets("Sheet1").Rows(cell1.Row) newrange1.Copy Destination:=Worksheets("Sheet3").Range("A" & unsubListCount + counter) newrange1.EntireRow.Delete End If Next Next End Sub 

Here is the error I get:

Answer 1

I think what happens when you delete a row, you lose reference to the range of Cell1 . So I reset it after uninstall, and deleted the link to newRange1. Give it a shot, I'm working on it. I also formatted the code a bit.

 Option Explicit Sub Testing() Dim counter As Long: counter = 0 Dim z As Long: z = 0 Dim x As Long: x = 0 Dim startRow As Long: startRow = 2 Dim Sheet1 As Worksheet: Set Sheet1 = ThisWorkbook.Sheets("Sheet1") Dim Sheet2 As Worksheet: Set Sheet2 = ThisWorkbook.Sheets("Sheet2") Dim Sheet3 As Worksheet: Set Sheet3 = ThisWorkbook.Sheets("Sheet3") Dim rng1 As Range: Set rng1 = Sheet1.Range("D1:D" & Sheet1.UsedRange.Rows.Count) Dim rng2 As Range: Set rng2 = Sheet2.Range("D1:D" & Sheet2.UsedRange.Rows.Count) Dim unsubListCount As Long: unsubListCount = Sheet3.UsedRange.Rows.Count Dim cell1 As Range Dim cell2 As Range Dim newrange1 As Range ' Brute Loop through each Sheet1 row to check with Sheet2 For z = rng1.Count To startRow Step -1 Set cell1 = Sheet1.Cells(z, 4) For x = rng2.Count To startRow Step -1 Set cell2 = Sheet2.Cells(x, 4) If cell1 = cell2 Then counter = counter + 1 Set newrange1 = Sheet1.Rows(cell1.Row) newrange1.Copy Destination:=Sheet3.Range("A" & unsubListCount + counter) newrange1.EntireRow.Delete Set newrange1 = Nothing Set cell1 = Sheet1.Cells(z, 4) End If Next Next End Sub 

Answer 2

Your inner loop creates a lot of step-by-step actions that are better done with Application.Match . Using .UsedRange to get the extents of values ​​in D columns is better if you look for the last value from the bottom up.

 Option Explicit Sub Step2() Dim z As Long, startRow As Long Dim rng2 As Range, wk3 As Worksheet, chk As Variant startRow = 2 z = 0 Set wk3 = Worksheets("Sheet3") ' Select all emails in Sheet1 and Sheet2 (exclude first row) With Worksheets("Sheet2") Set rng2 = .Range(.Cells(2, "D"), .Cells(.Rows.Count, "D").End(xlUp)) End With With Worksheets("Sheet1") For z = .Cells(.Rows.Count, "D").End(xlUp).Row To startRow Step -1 chk = Application.Match(.Cells(z, "D").Value2, rng2, 0) If Not IsError(chk) Then .Cells(z, "A").EntireRow.Copy _ Destination:=wk3.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) .Cells(z, "A").EntireRow.Delete End If Next End With End Sub 

As noted by Ryan Wildry , your original problem continued the loop and compared after deleting the row. This can be avoided by adding Exit For after newrange1.EntireRow.Delete to jump out of the inner loop after a match is found. I do not think you should "reset cell1", as this may ruin the iteration of the loop.