Copy and paste row if condition is met

M

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: 118
Sort by date Sort by votes
mumps said:
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
Click to expand...
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?
 
Upvote 0

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
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
 
Upvote 0
mumps said:
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
Click to expand...
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.
 
Upvote 0
mattlim said:
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.
Click to expand...
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.
 
Upvote 0
mumps said:
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.
Click to expand...
Yes I'm changing it in the masterlist.
 
Upvote 0
mattlim said:
Yes I'm changing it in the masterlist.
Click to expand...
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: 7
  • Screenshot 2021-01-21 at 4.29.46 PM.png
    Screenshot 2021-01-21 at 4.29.46 PM.png
    250 KB · Views: 7
  • Screenshot 2021-01-21 at 4.37.20 PM.png
    Screenshot 2021-01-21 at 4.37.20 PM.png
    176.8 KB · Views: 7
Upvote 0
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.
 
Upvote 0
mumps said:
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.
Click to expand...
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
 
Upvote 0
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.
 
Upvote 0
mumps said:
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
Click to expand...
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: 3
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Add parts of row to table
Replies
3
Views
198
NoSparks
N
J
  • Solved
Code to copy over row if certain criteria is met
2
Replies
18
Views
552
mumps
mumps
T
  • Solved
=IF Formula Question
Replies
5
Views
250
Fluff
Fluff
U
  • Solved
Copy/Paste Rows on select criteria
Replies
4
Views
797
UTB
U
S
  • Solved
Copying a row to another tab when condition is met on expiry date
2
Replies
16
Views
709
kevin9999
K

Forum statistics

Threads
1,214,537
Messages
6,120,096
Members
448,944
Latest member
SarahSomethingExcel100

Share this page

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
Back
Top