I want to move rows based on values entered in last column of a worksheet. If the value entered is "A" in worksheet "Active", I want to move the row to one worksheet starting in row 5. If the value entered is "B" in worksheet "Active", I want to move the row to another worksheet starting in row 5. And lastly, if the value entered is "C" in worksheet "Active", I want to move the row to another worksheet starting in row 5. Plus, anytime data is entered (A, B, or C), I want that row added to the other worksheets at the end of the last row of data.
I have this code I pulled from somewhere and adjusted but I have limited experience with VBA. Please help!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("V:V")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Post Adoption - Approved").Cells(Rows.Count, "I").End(xlUp).Row
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row
If Target.Value = "Approved" Then
Rows(Target.Row).Copy Destination:=Sheets("Post Adoption - Approved").Rows(Lastrow)
Application.EnableEvents = False
Rows(Target.Row).Delete
Application.EnableEvents = True
Exit Sub
End If
Lastrow = Sheets("Post Adoption - Trial Period").Cells(Rows.Count, "I").End(xlUp).Row + 1
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row + 1
Application.EnableEvents = True
If Target.Value = "Trial" Then
Rows(Target.Row).Copy Destination:=Sheets("Post Adoption - Trial Period").Rows(Lastrowa)
Application.EnableEvents = False
Rows(Target.Row).Delete
End If
Lastrow = Sheets("Denied").Cells(Rows.Count, "I").End(xlUp).Row + 1
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row + 1
Application.EnableEvents = True
If Target.Value = "Denied" Then
Rows(Target.Row).Copy Destination:=Sheets("Denied").Rows(Lastrowa)
Application.EnableEvents = False
Rows(Target.Row).Delete
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
I have this code I pulled from somewhere and adjusted but I have limited experience with VBA. Please help!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("V:V")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Application.ScreenUpdating = False
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets("Post Adoption - Approved").Cells(Rows.Count, "I").End(xlUp).Row
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row
If Target.Value = "Approved" Then
Rows(Target.Row).Copy Destination:=Sheets("Post Adoption - Approved").Rows(Lastrow)
Application.EnableEvents = False
Rows(Target.Row).Delete
Application.EnableEvents = True
Exit Sub
End If
Lastrow = Sheets("Post Adoption - Trial Period").Cells(Rows.Count, "I").End(xlUp).Row + 1
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row + 1
Application.EnableEvents = True
If Target.Value = "Trial" Then
Rows(Target.Row).Copy Destination:=Sheets("Post Adoption - Trial Period").Rows(Lastrowa)
Application.EnableEvents = False
Rows(Target.Row).Delete
End If
Lastrow = Sheets("Denied").Cells(Rows.Count, "I").End(xlUp).Row + 1
Lastrowa = Sheets("Active").Cells(Rows.Count, "I").End(xlUp).Row + 1
Application.EnableEvents = True
If Target.Value = "Denied" Then
Rows(Target.Row).Copy Destination:=Sheets("Denied").Rows(Lastrowa)
Application.EnableEvents = False
Rows(Target.Row).Delete
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub