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: 
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
    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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                    Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                    Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
When I enter the program in column K, it doesn't even copy and paste to the relevant program sheet
 
Upvote 0

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
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
    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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                    Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                    Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
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
    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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                        Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                        Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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("I" & lRow).Formula = "=DATEDIF(H" & lRow & ",TODAY(),""y"")"
                    Intersect(Rows(Target.Row), Range("J:J")).Copy .Range("J" & lRow)
                    Intersect(Rows(Target.Row), Range("N:N")).Copy .Range("K" & 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
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
The same problems happens as with post #35. When I enter a program in column K, sometimes it works sometimes it doesnt. This is what appears when I hover over the error on IRow
 

Attachments

  • Screenshot 2021-02-05 at 5.16.57 PM.png
    Screenshot 2021-02-05 at 5.16.57 PM.png
    39.5 KB · Views: 2
Upvote 0
Some of your sheets are in table format and others are not. If you look at some of your named ranges, some refer to ranges up to row 1048576. Also, some columns in some of the sheets appear blank but contain formulas or data validation drop down lists. Any or all of these issues may be causing the problem. The code I suggested doesn't need the sheets to be in table format and doesn't refer to any named ranges. It also doesn't need formulas or drop down lists. So unless you need the named ranges and table formats, I would suggest that you convert all the sheets to ranges and delete all formulas, drop downs and named ranges (Masterlist excepted). The try the macro again and see if the problem persists.
 
Upvote 0
mumps said:
Some of your sheets are in table format and others are not. If you look at some of your named ranges, some refer to ranges up to row 1048576. Also, some columns in some of the sheets appear blank but contain formulas or data validation drop down lists. Any or all of these issues may be causing the problem. The code I suggested doesn't need the sheets to be in table format and doesn't refer to any named ranges. It also doesn't need formulas or drop down lists. So unless you need the named ranges and table formats, I would suggest that you convert all the sheets to ranges and delete all formulas, drop downs and named ranges (Masterlist excepted). The try the macro again and see if the problem persists.
Click to expand...
Ahh okay got it to work!! The only thing is that the Years of Service in the program sheets isn't accurate to the masterlist mattlim3 copy.xlsm
 
Upvote 0
In the Masterlist sheet you have the Assigned Date in column L which the formula in column M uses to calculate the Years of Service. You don't have the Assigned Date column in the other sheets so the formula can't work properly.
 
Upvote 0
mumps said:
In the Masterlist sheet you have the Assigned Date in column L which the formula in column M uses to calculate the Years of Service. You don't have the Assigned Date column in the other sheets so the formula can't work properly.
Click to expand...
Ahh can that be added in to the formula, so that all program sheets will be able to calculate Years of Service?
 
Upvote 0
Click here for your file. Please not that I have modified only sheets "Care" and "Bless" by adding the "Assigned Date" column. You will have to do the same for all the other sheets. My suggestion is that you delete all the other sheets (Masterlist excepted) then make a copy of "Care" as many times as needed and rename the new sheets to match the programmes. This way the new sheets will not be in table format. Don't forget to delete all the unnecessary named ranges.
 
Upvote 0
mumps said:
Click here for your file. Please not that I have modified only sheets "Care" and "Bless" by adding the "Assigned Date" column. You will have to do the same for all the other sheets. My suggestion is that you delete all the other sheets (Masterlist excepted) then make a copy of "Care" as many times as needed and rename the new sheets to match the programmes. This way the new sheets will not be in table format. Don't forget to delete all the unnecessary named ranges.
Click to expand...
Works perfectly! The last thing is how do I incorporate post #31 into the code? I'm still restarting my com for the code to work when the debugger appears.
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

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

Forum statistics

Threads
1,214,918
Messages
6,122,257
Members
449,075
Latest member
staticfluids

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