Copy and paste row if condition is met

[mattlim]

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.

 

[mumps]

Is the contact number in column D unique? We could use the "No." in column A which is unique, if we also copy column A to the destination sheet. Would that work for you?

 

[mattlim]

Is the contact number in column D unique? We could use the "No." in column A which is unique, if we also copy column A to the destination sheet. Would that work for you?

Contact number isn't unique also. Ah yes using column A would work

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("Q:Q")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range
    Application.ScreenUpdating = False
    Set fnd = Sheets(Target.Value).Range("A:A").Find(Target.Offset(, -16).Value, LookIn:=xlValues, lookat:=xlWhole)
    If fnd Is Nothing Then
        With Sheets(Target.Value)
            Intersect(Rows(Target.Row), Range("A:H,M:M")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Else
        MsgBox ("The data for " & Target.Offset(, -14) & " " & Target.Offset(, -15) & " already exists in sheet '" & Target.Value & "'.")
    End If
    Application.ScreenUpdating = True
End Sub

 

[mattlim]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("Q:Q")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range
    Application.ScreenUpdating = False
    Set fnd = Sheets(Target.Value).Range("A:A").Find(Target.Offset(, -16).Value, LookIn:=xlValues, lookat:=xlWhole)
    If fnd Is Nothing Then
        With Sheets(Target.Value)
            Intersect(Rows(Target.Row), Range("A:H,M:M")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    Else
        MsgBox ("The data for " & Target.Offset(, -14) & " " & Target.Offset(, -15) & " already exists in sheet '" & Target.Value & "'.")
    End If
    Application.ScreenUpdating = True
End Sub

Works like a charm, thanks a lot!
Is it possible to automatically highlight the whole row when column P is indicated as "terminated"?

 

[mattlim]

Works like a charm, thanks a lot!
Is it possible to automatically highlight the whole row when column P is indicated as "terminated"?

Additionally, if lets say person a changes his email and I change it on the masterlist, it doesn't change on the worksheet(program) that the person is in. Is there a way for it to update automatically? Or must I re-enter the program he is in to update his particulars?

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E:E,Q:Q")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case Is = 5
            Set fnd = Sheets(Target.Offset(, 12).Value).Range("A:A").Find(Target.Offset(, -4).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                Sheets(Target.Offset(, 12).Value).Range("E" & fnd.Row) = Target
            End If
        Case Is = 17
            If Target.Offset(, -1) <> "" Then
                Range("A" & Target.Row).Resize(, 23).Interior.ColorIndex = 3
            End If
            Set fnd = Sheets(Target.Value).Range("A:A").Find(Target.Offset(, -16).Value, LookIn:=xlValues, lookat:=xlWhole)
            If fnd Is Nothing Then
                With Sheets(Target.Value)
                    Intersect(Rows(Target.Row), Range("A:H,M:M")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                End With
            Else
                MsgBox ("The data for " & Target.Offset(, -14) & " " & Target.Offset(, -15) & " already exists in sheet '" & Target.Value & "'.")
            End If
    End Select
    Application.ScreenUpdating = True
End Sub

Also, to avoid clutter, please click the "Reply" button not the "+Quote" button when responding.

 

[mattlim]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("E:E,Q:Q")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Dim fnd As Range
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case Is = 5
            Set fnd = Sheets(Target.Offset(, 12).Value).Range("A:A").Find(Target.Offset(, -4).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                Sheets(Target.Offset(, 12).Value).Range("E" & fnd.Row) = Target
            End If
        Case Is = 17
            If Target.Offset(, -1) <> "" Then
                Range("A" & Target.Row).Resize(, 23).Interior.ColorIndex = 3
            End If
            Set fnd = Sheets(Target.Value).Range("A:A").Find(Target.Offset(, -16).Value, LookIn:=xlValues, lookat:=xlWhole)
            If fnd Is Nothing Then
                With Sheets(Target.Value)
                    Intersect(Rows(Target.Row), Range("A:H,M:M")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                End With
            Else
                MsgBox ("The data for " & Target.Offset(, -14) & " " & Target.Offset(, -15) & " already exists in sheet '" & Target.Value & "'.")
            End If
    End Select
    Application.ScreenUpdating = True
End Sub

Also, to avoid clutter, please click the "Reply" button not the "+Quote" button when responding.

I am so so sorry for the small constant changes. This is the last one!
I rearranged the columns. So a summary of what I’m hoping for.

• Columns A-J, M-N copied to the relevant program sheet indicated in column K.
• For the same columns indicated above to be updated automatically in the program sheets when it is changed on the masterlist.
• For the whole row to be highlighted as red when indicated as “Terminated” in column J, highlighted blue when indicated as “Inactive”. For the highlight to adjust accordingly. Eg: From highlighted blue as inactive to it not being highlighted when changed to active.
• If Bob was Unassigned in column K, and I change him to ignite, is it possible to delete his particulars from the unassigned tab?
• Using column A as the unique identifier to prevent duplicates.

If I were to add more columns later on from column O onwards, it wouldn’t affect the code in any way right?

Volunteer Masterlist (with code) copy.xlsm

Shared with Dropbox

www.dropbox.com

 

[mumps]

Columns A-J, M-N copied to the relevant program sheet indicated in column K.

In the program sheets, column N (Platform Recruited) does not exist. Do you want column N of the Masterlist to be added to column K in the program sheets?

 

[mattlim]

In the program sheets, column N (Platform Recruited) does not exist. Do you want column N of the Masterlist to be added to column K in the program sheets?

Oh yes i forgot to add it in

 

[mumps]

Try:

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
    Application.ScreenUpdating = False
    Select Case Target.Column
        Case 2 To 8
            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
        Case Is = 10
            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
            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
            Select Case Target.Value
                Case "IGNITE"
                    Set fnd = Sheets("Unassigned").Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If Not fnd Is Nothing Then
                        Sheets("Unassigned").Rows(fnd.Row).Delete
                        With Sheets(Target.Value)
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("M:M")).Copy .Cells(.Rows.Count, "I").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Cells(.Rows.Count, "J").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Cells(.Rows.Count, "K").End(xlUp).Offset(1)
                        End With
                    Else
                        MsgBox ("The data for " & Target.Offset(, -8) & " " & Target.Offset(, -9) & " does not exist in sheet 'Unassigned'.")
                        Application.Undo
                    End If
                Case Else
                    Set fnd = Sheets(Target.Value).Range("A:A").Find(Range("A" & Target.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
                    If fnd Is Nothing Then
                        With Sheets(Target.Value)
                            Intersect(Rows(Target.Row), Range("A:H")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("M:M")).Copy .Cells(.Rows.Count, "I").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("J:J")).Copy .Cells(.Rows.Count, "J").End(xlUp).Offset(1)
                            Intersect(Rows(Target.Row), Range("N:N")).Copy .Cells(.Rows.Count, "K").End(xlUp).Offset(1)
                        End With
                    Else
                        MsgBox ("The data for " & Target.Offset(, -8) & " " & Target.Offset(, -9) & " already exists in sheet '" & Target.Value & "'.")
                    End If
            End Select
        Case Is = 14
            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 Select
    Application.ScreenUpdating = True
End Sub