Copy and paste row if condition is met

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
I know this is a common question asked and answered but i just cant find one that works for me. So I would like the entire row to be copied from sheet 1 if the condition "Children" is met in column D to sheet 2, row 2. Sheet 1 is being constantly updated, so it would be great if the macro doesn't duplicate data but only inserts the new entries to sheet 2. Same goes for the condition "Ignite" in column D copied to sheet 3.

I have zero knowledge in VBA but I need to sort some data. The only thing I know to do is create the button, but without the macro its useless haha. Any help is greatly appreciated. The picture is just a sample, since IC numbers are confidential.
 

Attachments

  • Screenshot 2020-12-09 at 5.23.21 PM.png
    Screenshot 2020-12-09 at 5.23.21 PM.png
    213.2 KB · Views: 18

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Try:
VBA Code:
Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 11 Then
        oldVal = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:H,J:K,M:N")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range, lRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Column
        Case 2 To 8
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
        Case Is = 10
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
            Select Case Target.Value
                Case "Terminated"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 3
                Case "Inactive"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
                Case "Active"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
            End Select
        Case Is = 11
            If oldVal <> "" Then
                Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(oldVal).Rows(fnd.Row).Delete
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
                       
                    End With
                Else
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
                    End With
                End If
            Else
                With Sheets(Target.Value)
                    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                    .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("M" & lRow)
                End With
            End If
            Target.Offset(, 1).Select
        Case Is = 14
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 11) = Target
                End If
            End If
    End Select
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
The debugger problem is solved!

So I tweaked the code a little, because when I update column L&M in the masterlist, it doesn't automatically update on the relevant program sheet. Also when you added the additional column I of Assigned date into the program sheets, columns J&N from the masterlist is still copied to columns J&K on the program sheet rather than K&L because of the added column I of assigned date.

I fixed both issues, only for another problem to occur: the row doesn't change the highlight colour when column J is updated on the masterlist. Additionally, is it possible for the program sheet to be highlighted automatically when column J is updated in the masterlist? Because as of now, I need to re-enter the data in column K on the masterlist for the row in the relevant program sheet to be highlighted accordingly.

 

Some videos you may like

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
The debugger problem is solved!

So I tweaked the code a little, because when I update column L&M in the masterlist, it doesn't automatically update on the relevant program sheet. Also when you added the additional column I of Assigned date into the program sheets, columns J&N from the masterlist is still copied to columns J&K on the program sheet rather than K&L because of the added column I of assigned date.

I fixed both issues, only for another problem to occur: the row doesn't change the highlight colour when column J is updated on the masterlist. Additionally, is it possible for the program sheet to be highlighted automatically when column J is updated in the masterlist? Because as of now, I need to re-enter the data in column K on the masterlist for the row in the relevant program sheet to be highlighted accordingly.

Not sure if this code will be easier to resolve. For this one the highlight still works on the masterlist, but when columns L&M are updated on the masterlist it doesn't automatically update to the relevant program sheet. Would also like any updates on column J in the masterlist be automatically highlighted in the relevant program sheet without needing to re-enter data in column K on the masterlist.

 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,111
Try:
VBA Code:
Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 11 Then
        oldVal = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:H,J:L,M:N")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range, lRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Column
        Case 2 To 8
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
        Case Is = 10
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    With Sheets(Range("K" & Target.Row).Value)
                        .Cells(fnd.Row, 11) = Target
                        Select Case Target.Value
                            Case "Terminated"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 38
                            Case "Inactive"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 33
                            Case "Unassigned"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 40
                            Case "Active"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                           Case "Pending"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                        End Select
                    End With
                End If
            End If
            Select Case Target.Value
                Case "Terminated"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 38
                Case "Inactive"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
                Case "Unassigned"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 40
                Case "Active"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
               Case "Pending"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
            End Select
        Case Is = 11
            If oldVal <> "" Then
                Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(oldVal).Rows(fnd.Row).Delete
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                        
                    End With
                Else
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                    End With
                End If
            Else
                With Sheets(Target.Value)
                    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                    .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                End With
            End If
            Target.Offset(, 1).Select
        Case Is = 12
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 9) = Target
                End If
            End If
        Case Is = 14
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 12) = Target
                End If
            End If
    End Select
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Try:
VBA Code:
Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 11 Then
        oldVal = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:H,J:L,M:N")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range, lRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Column
        Case 2 To 8
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
        Case Is = 10
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    With Sheets(Range("K" & Target.Row).Value)
                        .Cells(fnd.Row, 11) = Target
                        Select Case Target.Value
                            Case "Terminated"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 38
                            Case "Inactive"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 33
                            Case "Unassigned"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 40
                            Case "Active"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                           Case "Pending"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                        End Select
                    End With
                End If
            End If
            Select Case Target.Value
                Case "Terminated"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 38
                Case "Inactive"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
                Case "Unassigned"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 40
                Case "Active"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
               Case "Pending"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
            End Select
        Case Is = 11
            If oldVal <> "" Then
                Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(oldVal).Rows(fnd.Row).Delete
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                      
                    End With
                Else
                    With Sheets(Target.Value)
                        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                        Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                        .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                    End With
                End If
            Else
                With Sheets(Target.Value)
                    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                    .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                End With
            End If
            Target.Offset(, 1).Select
        Case Is = 12
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 9) = Target
                End If
            End If
        Case Is = 14
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 12) = Target
                End If
            End If
    End Select
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Works great! Last thing is the formula for date of birth gets jumbled up in the program sheets. Could you unjumble it haha
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS

ADVERTISEMENT

Works great! Last thing is the formula for date of birth gets jumbled up in the program sheets. Could you unjumble it haha
Sorry ignore the last post, there's nothing wrong with the date of birth.
Could the row be deleted from the relevant program sheet when I delete data from column K in the masterlist? As of now it transfers to the relevant program sheet when changed on the masterlist, but can it be deleted from the program sheet if column K is empty on the masterlist?
 
Last edited:

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,111
Try:
VBA Code:
Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 11 Then
        oldVal = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:H,J:L,M:N")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range, lRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Column
        Case 2 To 8
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
        Case Is = 10
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    With Sheets(Range("K" & Target.Row).Value)
                        .Cells(fnd.Row, 11) = Target
                        Select Case Target.Value
                            Case "Terminated"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 38
                            Case "Inactive"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 33
                            Case "Unassigned"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 40
                            Case "Active"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                           Case "Pending"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                        End Select
                    End With
                End If
            End If
            Select Case Target.Value
                Case "Terminated"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 38
                Case "Inactive"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
                Case "Unassigned"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 40
                Case "Active"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
               Case "Pending"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
            End Select
        Case Is = 11
            If oldVal <> "" Then
                If Target = "" Then
                    Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Sheets(oldVal).Rows(fnd.Row).Delete
                    End If
                Else
                    Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Sheets(oldVal).Rows(fnd.Row).Delete
                        With Sheets(Target.Value)
                            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                            .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                            Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                            
                        End With
                    Else
                        With Sheets(Target.Value)
                            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                            .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                            Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                        End With
                    End If
                End If
            Else
                With Sheets(Target.Value)
                    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                    .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                End With
            End If
            Target.Offset(, 1).Select
        Case Is = 12
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 9) = Target
                End If
            End If
        Case Is = 14
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 12) = Target
                End If
            End If
    End Select
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Solution

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Try:
VBA Code:
Dim oldVal As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column = 11 Then
        oldVal = Target.Value
    End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B:H,J:L,M:N")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range, lRow As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Column
        Case 2 To 8
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, Target.Column) = Target
                End If
            End If
        Case Is = 10
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    With Sheets(Range("K" & Target.Row).Value)
                        .Cells(fnd.Row, 11) = Target
                        Select Case Target.Value
                            Case "Terminated"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 38
                            Case "Inactive"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 33
                            Case "Unassigned"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = 40
                            Case "Active"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                           Case "Pending"
                                .Cells(fnd.Row, 1).Resize(, 12).Interior.ColorIndex = xlNone
                        End Select
                    End With
                End If
            End If
            Select Case Target.Value
                Case "Terminated"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 38
                Case "Inactive"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 33
                Case "Unassigned"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = 40
                Case "Active"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
               Case "Pending"
                    Range("A" & Target.Row).Resize(, 26).Interior.ColorIndex = xlNone
            End Select
        Case Is = 11
            If oldVal <> "" Then
                If Target = "" Then
                    Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Sheets(oldVal).Rows(fnd.Row).Delete
                    End If
                Else
                    Set fnd = Sheets(oldVal).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Sheets(oldVal).Rows(fnd.Row).Delete
                        With Sheets(Target.Value)
                            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                            .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                            Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                           
                        End With
                    Else
                        With Sheets(Target.Value)
                            lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                            .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                            Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                        End With
                    End If
                End If
            Else
                With Sheets(Target.Value)
                    lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    Intersect(Rows(Target.Row), Range("A:H")).Copy .Range("A" & lRow)
                    .Range("J" & lRow).Formula = "=DATEDIF(I" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("L:M")).Copy .Range("I" & lRow)
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("K" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("L" & lRow)
                End With
            End If
            Target.Offset(, 1).Select
        Case Is = 12
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 9) = Target
                End If
            End If
        Case Is = 14
            If Range("K" & Target.Row) <> "" Then
                Set fnd = Sheets(Range("K" & Target.Row).Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not fnd Is Nothing Then
                    Sheets(Range("K" & Target.Row).Value).Cells(fnd.Row, 12) = Target
                End If
            End If
    End Select
errHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Works perfectly. Thank you so much for your patience and expertise!! You're amazing
 

Watch MrExcel Video

Forum statistics

Threads
1,122,528
Messages
5,596,690
Members
414,088
Latest member
rodriboraun

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top