[Solved]-Delete and shift cells up on a worksheet change-VBA Excel

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