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: 120
Sort by date Sort by votes
Click here to download your file. The problem may have been caused by the fact that somehow I accidentally left out the very first line in the code (Dim oldVal As String).
mattlim said:
I have to restart my com just for any code to work
Click to expand...
The reason this happened is because if the macro errors out and does not finish running, this line of code is not executed:
VBA Code: 
Application.EnableEvents = True
This line re-enables event macros after they have been disabled with this line:
VBA Code: 
Application.EnableEvents = False
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
mumps said:
Click here to download your file. The problem may have been caused by the fact that somehow I accidentally left out the very first line in the code (Dim oldVal As String).

The reason this happened is because if the macro errors out and does not finish running, this line of code is not executed:
VBA Code: 
Application.EnableEvents = True
This line re-enables event macros after they have been disabled with this line:
VBA Code: 
Application.EnableEvents = False
Click to expand...
The code works. Just that both the problems that I mentioned in post #26 still persists.

1. Enters "BLESS" in the masterlist sheet under column K in row 2 (Tay)
2. This row (Tay) has no status and no platform recruited (column J & N) on the masterlist sheet.
3. This row (Tay) is then copied to the BLESS sheet filling row 2, with column J & K blank since there is no data on the masterlist to copy from.
4. Enters "BLESS" in the masterlist sheet under column K in row 11 (Kwek).
5. This row (Kwek) is "Active" under column J, and “RLC” under column N on the masterlist sheet.
6. Row 11 (Kwek) is then copied to the BLESS sheet filling row 3.
7. Instead of "Active" appearing in column J and “RLC” in column K row 3 on the BLESS sheet, it appears on column J & K row 2, the empty cell.

I'm unable to key in new data without the debugger appearing. Every time I press enter after keying in new data in just one cell, the debugger comes up.
 

Attachments

  • Screenshot 2021-01-27 at 10.02.30 AM.png
    Screenshot 2021-01-27 at 10.02.30 AM.png
    97.1 KB · Views: 2
Upvote 0
mattlim said:
The code works. Just that both the problems that I mentioned in post #26 still persists.

1. Enters "BLESS" in the masterlist sheet under column K in row 2 (Tay)
2. This row (Tay) has no status and no platform recruited (column J & N) on the masterlist sheet.
3. This row (Tay) is then copied to the BLESS sheet filling row 2, with column J & K blank since there is no data on the masterlist to copy from.
4. Enters "BLESS" in the masterlist sheet under column K in row 11 (Kwek).
5. This row (Kwek) is "Active" under column J, and “RLC” under column N on the masterlist sheet.
6. Row 11 (Kwek) is then copied to the BLESS sheet filling row 3.
7. Instead of "Active" appearing in column J and “RLC” in column K row 3 on the BLESS sheet, it appears on column J & K row 2, the empty cell.

I'm unable to key in new data without the debugger appearing. Every time I press enter after keying in new data in just one cell, the debugger comes up.
Click to expand...
Additionally, the formula for column M in the masterlist sheet doesnt work when it gets copied to a program sheet in column I
 
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
    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)
                    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
            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:
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
            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)
                    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
            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...
When I try entering a program in column K in the masterlist, the debugger appears showing me this. Sometime it does sometimes it doesnt, so idk what's the issue.
 

Attachments

  • Screenshot 2021-01-28 at 9.39.09 PM.png
    Screenshot 2021-01-28 at 9.39.09 PM.png
    68.3 KB · Views: 6
Upvote 0
What message do you get when you click "Debug"?
 
Upvote 0
I can't seem to be able to reproduce the problem. When you get the error and the row is highlighted in yellow, place the cursor over "lRow" in that line of code. What do you get? Are you still working with the same file?
 
Upvote 0
mumps said:
I can't seem to be able to reproduce the problem. When you get the error and the row is highlighted in yellow, place the cursor over "lRow" in that line of code. What do you get? Are you still working with the same file?
Click to expand...
I tried to reproduce the problem, only for another line of code getting highlighted. This problem happened when I tried keying in a program under column K again. I'm using the same file. Is it possible that the code is affected because I've keyed in data? Sounds a bit weird, but it seems to be that way because your code works well with only a few rows of data. mattlim3 copy.xlsm
 

Attachments

  • Screenshot 2021-02-02 at 4.54.50 PM.png
    Screenshot 2021-02-02 at 4.54.50 PM.png
    63.9 KB · Views: 1
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
    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
 
Upvote 0
You must log in or register to reply here.

Similar threads

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

Forum statistics

Threads
1,216,137
Messages
6,129,093
Members
449,486
Latest member
malcolmlyle

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