VBA runtime Error object 424 required

[CalumJames]

Ok, so I've created the below VBA to move rows however it seems to work some of the time, but then others it throws a runtime 424 error.

Does anyone have any idea why?


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 11 Then
If Target = "Completed Minors" Then
Application.EnableEvents = False
nxtRow = Sheets("Completed Minors").Range("K" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy _
Destination:=Sheets("Completed Minors").Range("A" & nxtRow)
Target.EntireRow.Delete
End If
If Target = "Completed Majors" Then
Application.EnableEvents = False
nxtRow = Sheets("Completed Majors").Range("K" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy _
Destination:=Sheets("Completed Majors").Range("A" & nxtRow)
Target.EntireRow.Delete
End If
If Target = "Completed Other Sites" Then
Application.EnableEvents = False
nxtRow = Sheets("Completed Other Sites").Range("K" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy _
Destination:=Sheets("Completed Other Sites").Range("A" & nxtRow)
Target.EntireRow.Delete
End If
If Target = "Minor Transitions" Then
Application.EnableEvents = False
nxtRow = Sheets("Minor Transitions").Range("K" & Rows.Count).End(xlUp).Row + 1
Target.EntireRow.Copy _
Destination:=Sheets("Minor Transitions").Range("A" & nxtRow)
Target.EntireRow.Delete
End If
End If
Application.EnableEvents = True
End Sub

 

[Norie]

If any of the criteria are matched you are deleting Target along with the rest of the row it's in.

So when the code comes to the next one, there is no Target to work with.

Assuming it's Target is going to match one of the terms you could try a Select Case structure instead of all the If/End Ifs

Select Case Target.Value
 
        Case "Completed Minors" 
 
            Application.EnableEvents = False
            nxtRow = Sheets("Completed Minors").Range("K" & Rows.Count).End(xlUp).Row + 1
            Target.EntireRow.Copy _
                    Destination:=Sheets("Completed Minors").Range("A" & nxtRow)
            Target.EntireRow.Delete

         Case "Completed Majors" 

             Application.EnableEvents = False
             nxtRow = Sheets("Completed Minors").Range("K" & Rows.Count).End(xlUp).Row + 1
             Target.EntireRow.Copy _
                     Destination:=Sheets("Completed Minors").Range("A" & nxtRow)
             Target.EntireRow.Delete
....

End Select

That will make sure there is only ever one row deleted, if it there's a match of course.

 

[CalumJames]

Works perfectly - thank you