Check before copy row.

[JRLanger]

Hi, I have a Spreadsheet that I use to control my business finances. I have implemented some VBA code to make the Spreadsheet copy an entire row from one sheet to another when a certain value is entered on a cell (all with help from forums, I have never used VBA before and I have very few experience in programing).

I've also implemented some code to make the Spreadsheet auto fill dates in some cells and an Unique ID on the 'column A' cell of each row as son as any value is entered in any cell of that roll.

Now what I need to do is to create some code to make it check for this Unique ID before copying the entire row and if it finds the ID in the target Sheet it should copy the row overwriting the original, if not just copy in the first empty row (as it already does). This way, if I have to modify some value in a row that have already been copied to the target Sheet it will update the row in the target sheet instead of copying again (thats what the code is doing now).

Here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)


'Insert date on column 'J' when data entered in column 'K':
With Target
    If .Count > 1 Then Exit Sub
    If Not Intersect(Range("K:K"), .Cells) Is Nothing Then
        Application.EnableEvents = False
            With .Offset(0, -1)
                If .Value = "" Then
                    .NumberFormat = "dd/mm/yy"
                    .Value = Date
                End If
            End With
        Application.EnableEvents = True
    End If
End With


'Insert date on column 'B' and ID on column 'A' when data entered in any cell of the row:
With Target
If .Count > 1 Then Exit Sub
    Application.EnableEvents = False
        With Range("B" & Target.Row)
            If .Value = "" Then
                .NumberFormat = "dd/mm/yy"
                .Value = Date
            End If
            With Range("A" & Target.Row)
                If .Value = "" Then
                .FormulaR1C1 = "=R[-1]C+1"
                End If
            End With
        End With
    Application.EnableEvents = True
End With




'Copy row to personal Sheet when name is entered in column 'K':
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    
    Set rng1 = Target.EntireRow
    Set rng2 = Worksheets("Eduardo").Cells(Rows.Count, 1).End(xlUp) _
               .Offset(1, 0)
    Set rng3 = Worksheets("Junior").Cells(Rows.Count, 1).End(xlUp) _
               .Offset(1, 0)
    
    If Target.Column = 11 Then
        On Error GoTo endit
        Application.EnableEvents = False
        If Target.Value = "Eduardo" Then
            With rng1
                .Copy Destination:=rng2
            End With
        End If
        If Target.Value = "Junior" Then
            With rng1
                .Copy Destination:=rng3
            End With
        End If
    End If




endit:
    Application.EnableEvents = True
End Sub

Thanks in advance for any help.

 

[Warship]

Try: -not tested-

'Copy row to personal Sheet when name is entered in column 'K':
    Dim rng1 As Range
    Dim rng2 As Range
    Dim rng3 As Range
    
    Dim uniqueID As String
    Dim found As Range
    
    Set rng1 = Target.EntireRow
    Set rng2 = Worksheets("Eduardo").Cells(Rows.Count, 1).End(xlUp) _
               .Offset(1, 0)
    Set rng3 = Worksheets("Junior").Cells(Rows.Count, 1).End(xlUp) _
               .Offset(1, 0)
    
    If Target.Column = 11 Then
        On Error GoTo endit
        uniqueID = Cells(Target.Row, 1)
        Application.EnableEvents = False
        If Target.Value = "Eduardo" Then
            Set found = Worksheets("Eduardo").Cells.Find(uniqueID, , , xlWhole)
            If found Is Nothing Then
                With rng1
                    .Copy Destination:=rng2
                End With
            Else
                found.EntireRow.ClearContents
                rng1.Copy Destination:=Worksheets("Eduardo").Cells(found.Row, 1)
            End If
        End If
        If Target.Value = "Junior" Then
            Set found = Worksheets("Junior").Cells.Find(uniqueID, , , xlWhole)
            If found Is Nothing Then
                With rng1
                    .Copy Destination:=rng2
                End With
            Else
                found.EntireRow.ClearContents
                rng1.Copy Destination:=Worksheets("Junior").Cells(found.Row, 1)
            End If
        End If
    End If

~~~~~~~~~~~~~~~~~~~
If you have a name change or name addition, you will have to edit your code.
If that will ever be your situation you might try this, which wouldn't need edited due to name changes.
Just a thought... again -not tested-

'Copy row to personal Sheet when name is entered in column 'K':
    Dim rng1 As Range
    Dim rng2 As Range
    
    Dim uniqueID As String
    Dim found As Range
    Dim sName As String
    
    sName = Target.Value
    Set rng1 = Target.EntireRow
               
    If Target.Column = 11 Then
        On Error GoTo endit
        Application.EnableEvents = False
        uniqueID = Cells(Target.Row, 1)
        Set found = Worksheets(sName).Cells.Find(uniqueID, , , xlWhole)
        If found Is Nothing Then
            Set rng2 = Worksheets(sName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            rng1.Copy Destination:=rng2
        Else
            found.EntireRow.ClearContents
            rng1.Copy Destination:=Worksheets(sName).Cells(found.Row, 1)
        End If
    End If

 

[JRLanger]

I will test it and let you know if it works for me. Thanks a lot.

 

[JRLanger]

It worked, but there is some issues.
I need it to copy the row in the first empty row and it is inserting it in top of the table.

Other thing is that if I change any value in a row that has already been copied before I would like it to be updated in the target sheet, but it only updates the entire row if I re-enter the value in the 'column K'. Is there any way to solve this?

Thanks.

 

[Warship]

...it is inserting it in top of the table.

I made an error under "Junior"

.Copy Destination:=rng2

should be

.Copy Destination:=rng3

...it only updates the entire row if I re-enter the value in the 'column K'. Is there any way to solve this?

the code is triggered here (which is only watching Column 11 "K")

If Target.Column = 11 Then

maybe change it to

If Not Application.Intersect(Target, Range("A:K")) Is Nothing Then

 

[JRLanger]

Ok, the first part worked great, its copying the row in the correct Sheet at the first empty row at the bottom when I select Eduardo or Junior in the column K.

For the other part, if I change from 'If Target.Column = 11 Then' to 'If Not Application.Intersect(Target, Range("A:K")) Is Nothing Then' what it does is to copy the entire row to the personal Sheet if I enter 'Junior' or 'Eduardo' in any cell of the row (as opposed of only doing it when 'Junior' or 'Eduardo' is entered in the column K).
What Im trying to do is to copy the entire row to the personal Sheet when 'Junior' or 'Eduardo' is entered in the column K and update or overwrite the row in the personal Sheet whenever any value is altered in any cell of that row after that. Is it possible?

I can send you my Spreadsheet or post it somewhere if this will help you understand the situation.

Thanks a lot for the help so far.

 

[Warship]

yeah that wont work.
sorry I didn't think that one thru...
I'll take a better look...