VBA: Cut and Paste Not Working

[pahickham]

I have this code that is meant to either copy and paste from the "Inventory" list to the "Low" list, given a certain condition, or cut/paste/delete empty row from "inventory" list to "out of service" list. The copy and paste part works, but the cut section isn't pasting to the "out of service" list. Initially this wasn't an event type and worked fine, but then I tried converting it to an event type and now that section wont't work. I've had to rig a few things, so any help's appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)Dim i, LastRow


LastRow = Sheets("Inventory").Range("A" & Rows.Count).End(xlUp).row
Sheets("Out of Service").Range("A2:I500").ClearContents
Sheets("Low").Range("A2:I500").ClearContents
For i = 2 To LastRow


If Sheets("Inventory").Cells(i, "E").Value = "0" Then
Sheets("Inventory").Cells(i, "H").EntireRow.Cut Destination:=Sheets("Out of Service").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Inventory").Range("H:H").SpecialCells(xlBlanks).EntireRow.Delete
End If


If Sheets("Inventory").Cells(i, "D").Value < Cells(i, "E") Then
Sheets("Inventory").Cells(i, "H").EntireRow.Copy Destination:=Sheets("Low").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If


Next i
End Sub

Here's a link to the sheet:

https://app.box.com/s/wfxmfiew0pp9m4ehr3opzeepzgdidn1o


Link to Excel Guru:

https://www.excelguru.ca/forums/showthread.php?9798-VBA-Cut-and-Paste-Not-Working&p=40292#post40292

 

[rlv01]

If your Worksheet_Change sub is for sheet "Inventory", you likely need to disable events during the cut operation

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, LastRow

    LastRow = Sheets("Inventory").Range("A" & Rows.Count).End(xlUp).row
    Sheets("Out of Service").Range("A2:I500").ClearContents
    Sheets("Low").Range("A2:I500").ClearContents
    For i = 2 To LastRow

        If Sheets("Inventory").Cells(i, "E").Value = "0" Then
            Application.EnableEvents = False
            Sheets("Inventory").Cells(i, "H").EntireRow.Cut Destination:=Sheets("Out of Service").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Sheets("Inventory").Range("H:H").SpecialCells(xlBlanks).EntireRow.Delete
            Application.EnableEvents = True
        End If

        If Sheets("Inventory").Cells(i, "D").Value < Cells(i, "E") Then
            Sheets("Inventory").Cells(i, "H").EntireRow.Copy Destination:=Sheets("Low").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    Next i
End Sub