Forum Discussion
Move row to new sheet auto matically when updated as complete
- May 17, 2022
Please find the two codes below, one for Progress Sheet Module and another for Completed Sheet Module. I have tweaked the Progress Sheet Module code a bit so not it will also copy the %Completed column to the Completed Sheet i.e. now it will copy the range A:M instead of A:L.
You will have to follow the same steps I mentioned in my last post to place the codes on both the Sheet Modules.
Progress Sheet Module Code:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub Dim wsProgress As Worksheet Dim wsCompleted As Worksheet Dim dlr As Long Dim r As Long Set wsProgress = Worksheets("Progress") Set wsCompleted = Worksheets("Completed") On Error GoTo Skip: If Target.Column = 13 And Target.Row > 2 Then '13 here means Column M which is %Completed Column on Progress Sheet. Change it as per your need Application.EnableEvents = False If Target.Value = 1 Then r = Target.Row dlr = wsCompleted.Cells(Rows.Count, "A").End(xlUp).Row + 1 'Following line will coply the range A:M to the Completed Sheet at the bottom wsProgress.Range("A" & r & ":M" & r).Copy wsCompleted.Range("A" & dlr) wsProgress.Rows(r).Delete End If End If Skip: Application.EnableEvents = True End Sub
Completed Sheet Module Code:
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub Dim wsProgress As Worksheet Dim wsCompleted As Worksheet Dim dlr As Long Dim r As Long Set wsProgress = Worksheets("Progress") Set wsCompleted = Worksheets("Completed") On Error GoTo Skip: If Target.Column = 13 And Target.Row > 2 Then '13 here means Column M which is %Completed Column on Progress Sheet. Change it as per your need Application.EnableEvents = False If IsNumeric(Target.Value) And Target.Value < 1 Then r = Target.Row dlr = wsProgress.Cells(Rows.Count, "A").End(xlUp).Row + 1 'Following line will copy the range A:M to the Progress Sheet at the bottom wsCompleted.Range("A" & r & ":M" & r).Copy wsProgress.Range("A" & dlr) wsCompleted.Rows(r).Delete End If End If Skip: Application.EnableEvents = True End Sub
Please find the attached with both the codes in place.
Since you did not provide any detail on which is the column where you change the % completed status of a project and which range is to be copied from Progress Sheet to Completed Sheet, I am assuming that the layout is similar to the attached where column M is the % Completed column which is manually filled. The Progress Sheet Module in the attached contains the following Change_Event Code so once you change the %Completed in column M for any project in column C to 100%, that row will be copied to the Completed Sheet and will be deleted from the Progress Sheet.
Please modify the code below as per your requirement.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim wsProgress As Worksheet
Dim wsCompleted As Worksheet
Dim dlr As Long
Dim r As Long
Set wsProgress = Worksheets("Progress")
Set wsCompleted = Worksheets("Completed")
On Error GoTo Skip:
If Target.Column = 13 And Target.Row > 2 Then '13 here means Column M which is %Completed Column on Progress Sheet. Change it as per your need
Application.EnableEvents = False
If Target.Value = 1 Then
r = Target.Row
dlr = wsCompleted.Cells(Rows.Count, "A").End(xlUp).Row + 1
'Following line will coply the range A:L to the Completed Sheet starting from column A
wsProgress.Range("A" & r & ":L" & r).Copy wsCompleted.Range("A" & dlr)
wsProgress.Rows(r).Delete
End If
End If
Skip:
Application.EnableEvents = True
End Sub