Edit Code for deleting row after Cut/Paste Macro

[nairion]

I am attempting to have a macro cut a row from one worksheet to another whenever a cell in Column G is changed to "Closed."

The Code I have operating is: (supplied by helpful forum regulator #shoutout My Answer is This)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G:G")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Dim ans As Long
Dim Lastrowa As Long
Lastrowa = Sheets("Closed Projects").Cells(Rows.Count, "G").End(xlUp).Row + 1
If Target.Value = "Closed" Then Rows(Target.Row).Cut Destination:=Sheets("Closed Projects").Rows(Lastrowa)
End If
End Sub
​

When this works its magic, it effectively copies the row to the next page instead of cutting the row. It leaves empty rows in its wake that have to be manually deleted.

Thoughts?

Also, does this code work after a filter has been applied to the data?

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        On Error GoTo errHandler
        If Target = "Closed" Then
            Target.EntireRow.Copy Sheets("Closed Projects").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete
        End If
    End If
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Veritan]

Hello Nairion, see if the code below will work for you. I'm relatively sure that it will work with filtered data, but you'll want to test it out to see if it works for you.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ans&, Lastrowa&, CutRow&

    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        Lastrowa = Sheets("Closed Projects").Cells(Rows.Count, "G").End(xlUp).Row + 1
        If Target.Value = "Closed" Then
            CutRow = Target.Row
            Application.EnableEvents = False
            Rows(CutRow).Cut Destination:=Sheets("Closed Projects").Rows(Lastrowa)
            Rows(CutRow).Delete
            Application.EnableEvents = True
    End If
End Sub

 

[nairion]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        On Error GoTo errHandler
        If Target = "Closed" Then
            Target.EntireRow.Copy Sheets("Closed Projects").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            Target.EntireRow.Delete
        End If
    End If
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

This one worked for me. Thank you

 

[mumps]

You are very welcome.