Check if value already exists in column, if found copy paste content in current row

[Domithious]

Hello everyone.


I have a spreadsheet in which i would like to record cases, in a table, and track the progress of cases from Open to Close. The spec is for each update to be recorded in a new row (rather than have one row per case).

There will be some basic information recorded for each case, then updates and an 'Update Date'. What i am trying to achieve is to autofill the basic information if an update is made to an existing case. My VBA skill are very lacking, I've tried with xlookup, but this doesn't work if a new case in entered. I've searched for posts which would help, but nothing quite fits what I'm trying to do.

On the example below the Case ID is in column A, If i type an existing case ID into a new line i would like to copy and paste columns B, to F automatically and then manually type in Column G. If the 'Case ID' is new "Date Created" is populated with today's date.

I'm not sure if this is possible. Most of the other posts I've read copy data to a new Worksheet, rather than in the same table.

I have managed to populate 'Update Date' when an Update is made.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 And Target.Row > 1 And IsEmpty(Range("H" & Target.Row)) Then
Range("H" & Target.Row) = Date
End If
End Sub

Case ID	Date Created	Year	Month	Location	Status	Update	Update Date
Case1	22/02/2022	2022	Feb	London	Active	Open	22/02/2022
Case1	22/02/2022	2022	Feb	London	Active	Progress	27/02/2022
Case1	22/02/2022	2022	Feb	London	Active	More Progress	03/03/2022
Case2	01/03/2022	2022	Mar	Manchester	Active	Open	01/03/2022
Case2	01/03/2022	2022	Mar	Manchester	Active	Progress	08/03/2022
Case3	[Today's Date]	New Data	New Data	New Data	New Data	New Data	[Today's Date]
Case2	Copy+Paste	Copy+Paste	Copy+Paste	Copy+Paste	Copy+Paste	More Progress	[Today's Date]

Many thanks in advance for any help.

 

[BSALV]

Private Sub Worksheet_Change(ByVal Target As Range)
     With Target
          If .Count > 1 Then Exit Sub                           'more then 1 cell changed at once.
          If .Column <> 1 Or .Row = 1 Then Exit Sub             'only changes in column 1
          If WorksheetFunction.CountA(.Offset(, 1).Resize(, 7)) > 0 Then Exit Sub     'the 7 cells at the RHS aren't empty

          r = Application.Match(.Value, Range("A1").Resize(.Row - 1), 0)     'find 1st row with same ID
          If IsNumeric(r) Then
               .Offset(, 1).Resize(, 5).Value = Cells(r, 2).Resize(, 5).Value     'copy 5 values
               Application.Goto .Offset(, 6), 0                 'goto column G
          Else
               .Offset(, 1).Resize(, 3).Value = Array(Date, Year(Date), WorksheetFunction.Proper(Format(Date, "Mmm")))     'add 3 columns
               Application.Goto .Offset(, 4), 0
          End If
     End With
End Sub

 

[Domithious]

Hello BSALV. Thank you, works perfectly!

 

[Domithious]

One more follow up. I've added an additional column to the end "Resolved Date". How would i populate this with today's date if "Status" column is changed to 'Closed'. This i my first week using VBA, so at a very basic.

I tried and number of variations along the lines of:

If Target.Column= 6 And Target.Value = "Closed" Then
.Offset (0, 3).Value = Date
End If

Added between the End With and End Sub of the previous code

 

[BSALV]

as 1st line of your module add "option compare text" to make that whole module (in almost all cases) case insensitive, otherwise "closed" 'll not be valid !

Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
     With Target
          If .Count > 1 Then Exit Sub                           'more then 1 cell changed at once.
          If .Row = 1 Then Exit Sub                             'only changes in column 1


          If .Column = 1 Then                                   'you change in the 1st column
               If WorksheetFunction.CountA(.Offset(, 1).Resize(, 7)) > 0 Then Exit Sub     'the 7 cells at the RHS aren't empty

               r = Application.Match(.Value, Range("A1").Resize(.Row - 1), 0)     'find 1st row with same ID
               If IsNumeric(r) Then
                    .Offset(, 1).Resize(, 5).Value = Cells(r, 2).Resize(, 5).Value     'copy 5 values
                    Application.Goto .Offset(, 6), 0            'goto column G
               Else
                    .Offset(, 1).Resize(, 3).Value = Array(Date, Year(Date), WorksheetFunction.Proper(Format(Date, "Mmm")))     'add 3 columns
                    Application.Goto .Offset(, 4), 0
               End If
          ElseIf .Column = 6 And .Value = "Closed" Then         'you change the 6th column into "closed"
               .Offset(0, 3).Value = Date
          End If
     End With
End Sub