CODEWITHSUNDEEP
vba
cyboashu
cyboashu

Reputation: 10443

Delete and shift cells up on a worksheet change

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

Upvotes: 2

Views: 8312

Answers (1)

cyboashu
cyboashu

Reputation: 10443

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

Upvotes: 2

Related Questions