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:
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
1. It works when someone goes from Unassigned in column K to IGNITE, the particulars are deleted from the Unassigned sheet. But it doesnt work for the other sheets though. Can the particulars be deleted from the Unassigned sheet when the person is catergorized to any other sheet in column K? Can it be done vice versa too? For example: If bob was in IGNITE, and I move him to Unassigned or Care, his particulars will be deleted from IGNITE and moved to Unassigned or Care. Can this be done across all sheets?
2. Those whose status in column J are highlighted in the masterlist sheet, can they also be highlighted in the respective sheets?
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,144
Hopefully, I understood correctly. Replace the current macro with the following:
VBA Code:
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
    Application.ScreenUpdating = False
    Application.EnableEvents = 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
            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)
                    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
                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
            End If
            Target.Offset(, 1).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.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Hopefully, I understood correctly. Replace the current macro with the following:
VBA Code:
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
    Application.ScreenUpdating = False
    Application.EnableEvents = 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
            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)
                    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
                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
            End If
            Target.Offset(, 1).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.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Strangely it doesn't work. I still can highlight on the masterlist sheet, but it doesnt apply on the relevant program sheet. This code doesn't copy and paste the row after I indicate the program in column K to the relevant program sheet either, nor does it delete the row from one program sheet when I change the program in column K. After a few minutes, the code stops working altogether, and I'll have to restart my com to get the previous code to work.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,144
This code doesn't copy and paste the row after I indicate the program in column K to the relevant program sheet either, nor does it delete the row from one program sheet when I change the program in column K.
Are you changing the program in column K in the Masterlist or in the relevant program sheet? Currently, the change always has to be made in the Masterlist.
 

mattlim

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

ADVERTISEMENT

Are you changing the program in column K in the Masterlist or in the relevant program sheet? Currently, the change always has to be made in the Masterlist.
Yes I'm changing it in the masterlist.
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Yes I'm changing it in the masterlist.
Also, this really weird thing happens. When I added Kwek into the BLESS sheet, Kwek's status as "Active" is filled at the first empty cell. This happens across all the sheets, for columns I, J, and K.
Additionally, every time I press enter after keying in something in a cell, the debugger will appear. (The moment I entered dsf, that window appears) Is there a way around this, so that I can enter data without that appearing constantly?
 

Attachments

  • Screenshot 2021-01-21 at 4.28.27 PM.png
    Screenshot 2021-01-21 at 4.28.27 PM.png
    231 KB · Views: 5
  • Screenshot 2021-01-21 at 4.29.46 PM.png
    Screenshot 2021-01-21 at 4.29.46 PM.png
    250 KB · Views: 5
  • Screenshot 2021-01-21 at 4.37.20 PM.png
    Screenshot 2021-01-21 at 4.37.20 PM.png
    176.8 KB · Views: 5

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,144

ADVERTISEMENT

In your last screen shot, "Years of Service" is in column I. In the file you posted, "Years of Service" is in column M. I tested the macro on the file you posted and it works properly. It looks like you are using the macro in a different file from the one you posted. Please upload a copy of the file which is not working for you. Click here for the file you posted. Try it out.
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
In your last screen shot, "Years of Service" is in column I. In the file you posted, "Years of Service" is in column M. I tested the macro on the file you posted and it works properly. It looks like you are using the macro in a different file from the one you posted. Please upload a copy of the file which is not working for you. Click here for the file you posted. Try it out.
Its a screenshot of the program(IGNITE, BLESS etc) sheet, that's why "Years of Service" is in column I. "Years of Service" is still in column M on the masterlist sheet
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,144
Can you upload a copy of the file that is giving you these problems? Describe step by step referring to specific cells, rows, columns and sheets what you are doing that produces the errors you described.
 

mattlim

New Member
Joined
Dec 9, 2020
Messages
32
Office Version
  1. 2019
Platform
  1. MacOS
Can you upload a copy of the file that is giving you these problems? Describe step by step referring to specific cells, rows, columns and sheets what you are doing that produces the errors you described
The latest file I uploaded is the same file I'm using.
1. On the masterlist sheet, I key in "Terminated" in column J in row 2, and the entire row is highlighted red. So that works.
2. On the masterlist sheet, I key in "BLESS" in column K row 2, and the debugger appears (refer to screenshot).
3. I close the debugger
4. I key in "Active" in column J row 2, but it doesn't change the highlight to blue.
5. This now tells me that the code doesn't work at all.

I have to restart my com just for any code to work. If I dont restart it, GBA doesnt work at all. This is the problem I encountered for the latest code that you gave, which I mentioned in the post on Wed at 2:40pm, #23 post.
 

Attachments

  • Screenshot 2021-01-26 at 4.17.22 PM.png
    Screenshot 2021-01-26 at 4.17.22 PM.png
    148.2 KB · Views: 1

Watch MrExcel Video

Forum statistics

Threads
1,122,995
Messages
5,599,256
Members
414,299
Latest member
thenewworld

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