Vba to move row from one sheet to another

[jwilliamson]

I'm looking to move rows to another sheet when a value in "H" is changed to "closed"

 

[JLGWhiz]

This event code would execute when changes are made in column H. You can modify it for the row to move if it is not the target row. The code goes in the worksheet code module.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If LCase(Target.Value) = "closed" Then
            Target.EntireRow.Cut Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    End If
End Sub

 

[jwilliamson]

thanks for this, it worked. But I have a running list of issues in sheet1, when I "close" an issue i need all the issues marked as closed moving to sheet2. This code deletes and replaces each item that gets marked as closed. It keeps putting them in row 2. Is there a way to have the issues getting closed to end up in a list on sheet 2. Thank you

 

[jwilliamson]

thanks for this, it worked. But I have a running list of issues in sheet1, when I "close" an issue i need all the issues marked as closed moving to sheet2. This code deletes and replaces each item that gets marked as closed. It keeps putting them in row 2. Is there a way to have the issues getting closed to end up in a list on sheet 2. Thank you

 

[JLGWhiz]

Your column A must be blank, try this modified version. Delete the first one.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim lr As Long
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If LCase(Target.Value) = "closed" Then
            lr = Sheets(2).Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
            Target.EntireRow.Cut Sheets(2).Cells(lr, 1)
        End If
    End If
End Sub

 

[jwilliamson]

I need data in the A column. It worked for couple then gave me run time error 91 "object variable or with block variable not set? Sorry Im real new

 

[JLGWhiz]

Delete the second version and try this modified version.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim lr As Long
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If Target <> "" Then
            If LCase(Target.Value) = "closed" Then
                lr = Sheets(2).Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                Target.EntireRow.Cut Sheets(2).Cells(lr, 1)
            End If
        End If
    End If
End Sub

I am not sure why you got that particular error message, but hopefully this will avoid it.

 

[jwilliamson]

I got the same message, and the debug highlighted this line of the code lr = Sheets(2).Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1

 

[JLGWhiz]

If the entire sheet 2 is blank then you would get that message because there is no previous for it to go to. This should fix that.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim lr As Long
    If Not Intersect(Target, Range("H:H")) Is Nothing Then
        If Target <> "" Then
            If LCase(Target.Value) = "closed" Then
                If Application.CountA(Sheets(2).Rows(1)) = 0 Then
                    Target.EntireRow.Cut Sheets(2).Range("A1")
                Else
                    lr = Sheets(2).Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row + 1
                    Target.EntireRow.Cut Sheets(2).Cells(lr, 1)
                End If
            End If
        End If
    End If
End Sub

 

[jwilliamson]

That works, thank you very much!!!! very helpful and responsive. This Forum is great.