Delete and shift cells up on a worksheet change - vba

Question

Note: One of the users asked this question and after I answered he delete it. I am just reposting the question and answer as in my opinion its a good example of bad coding habits and highlights why one needs to use Option Explicit
I have a worksheet change event where if Column I on sheet "current" is altered, it will then cut/paste that current row into the "completed" sheet. Only issue is that I need the empty row to delete from the sheet. My current code is only causing it to clear the row, and not delete/shift it up. How could I go about deleting a row and shifting up, without effecting the on change event?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim LastRowCompleted As Long
Dim RowToDelete As Long
RowToDelete = 0
LastRowCompleted = Sheets("completed").Cells(Sheets("completed").Rows.Count, "A").End(xlUp).Row
LastRowCompleted = LastRowCompleted + 1 'Next row after last row
Set KeyCells = Range("I:I")
Application.EnableEvents = False
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
'Cut and Paste Row
Target.EntireRow.Cut Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted)
'Mark to delete row
RowToDelete = Target.EntireRow.Row
End If
Application.EnableEvents = True
Call DeleteRow(RowToDelete)
End Sub
Sub DeleteRow(Row As Long)
If RowsToDelete > 0 Then
Rows(Row).EntireRow.Delete Shift:=xlToUp
End If
End Sub

Answer 1

Always use Option Explicit
There is nothing called xlToUp correct enum value is xlUp
This is wrong
Sub DeleteRow(Row As Long)
If RowsToDelete > 0 Then
Rows(Row).EntireRow.Delete Shift:=xlToUp
End If
End Sub
There is no RowsToDelete variable so your condition always evaluates to false.
Correct code will be
Sub DeleteRow(RowsToDelete As Long)
If RowsToDelete > 0 Then
Rows(RowsToDelete).EntireRow.Delete Shift:=xlUp
End If
End Sub
Enable events after deleting the Row else you will get stuck in infinite loop.
Call DeleteRow(RowToDelete)
Application.EnableEvents = True
Always set CutCopyMode=False after cut or copy
This will work.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim LastRowCompleted As Long
Dim RowToDelete As Long
RowToDelete = 0
LastRowCompleted = Sheets("completed").Cells(Sheets("completed").Rows.Count, "A").End(xlUp).Row
LastRowCompleted = LastRowCompleted + 1 'Next row after last row
Set KeyCells = Range("I:I")
Application.EnableEvents = False
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
'Cut and Paste Row
Target.EntireRow.Cut Sheets("completed").Range(LastRowCompleted & ":" & LastRowCompleted)
Application.CutCopyMode = False
'Mark to delete row
RowToDelete = Target.EntireRow.Row
End If
Call DeleteRow(RowToDelete)
Application.EnableEvents = True
End Sub
Sub DeleteRow(RowsToDelete As Long)
If RowsToDelete > 0 Then
Rows(RowsToDelete).EntireRow.Delete Shift:=xlUp
End If
End Sub