Forum Discussion

Gerdus4's avatar
Gerdus4
Copper Contributor
May 14, 2022
Solved

Move row to new sheet auto matically when updated as complete

I have a Project Information Schedule with projects listed in column C rows 3 to 150 with information for each project in the same row.  I have a column that gets manually updated from 0% to 100%. O...
  • Subodh_Tiwari_sktneer's avatar
    May 17, 2022

    Gerdus4 

     

    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.

     

     

     

Resources