Everytime value is updated, the title of updated value is copied to another sheet-CodePudding

I try to create a history database, sort of.

What I have done is if a value in Sheet1 C1 is updated, the previous value in cell A1 will be copied to Sheet2 C1. And if I update again the value in Sheet1 A1, the value will be copied again to Sheet2 C2, below the previous copy, and so on. Likewise, when a value in Sheet1 C2 is updated, it will be copied down below the previous copy of Sheet1 C1 value.

Now, after the value is updated, what I want to create is the title of which value being updated also being copied to Sheet2 B1, same as the value copy mechanism. Thank you.

The code is as follows:

Private Sub worksheet_change(ByVal target As Range)
    If target.Column = 3 Then 'Determine which column is input cell
        Dim col As Long
        Dim intlastrow As Long
        
        col = target.Column  'Determine which row/column is output cell
        intlastrow = Sheet4.Cells(Rows.Count, col).End(xlUp).Row
        If intlastrow = 1 Then 'Populate Row 1 or increment
            If Sheet4.Cells(intlastrow, col).Value <> "" Then
                intlastrow = intlastrow   1
            End If
        Else
            intlastrow = intlastrow   1
        End If
        Sheet4.Cells(intlastrow, col) = target.Value
    End If
End Sub

CodePudding user response：

Solution with minimal changes:

You're pretty close with what you have, but here's my solution with as few changes as possible:

Private Sub worksheet_change(ByVal target As Range)
    If target.Column = 3 Then 'Determine which column is input cell
        Dim col As Long
        Dim intlastrow As Long
        Dim sh_History As Worksheet
        Set sh_History = ThisWorkbook.Sheets("Sheet2")  ' You seem to be using Sheet4, but I _
' don't have a Sheet4, so I set an object variable and use whatever name I give the _
' worksheet.  
        
        col = target.Column  'Determine which row/column is output cell
        intlastrow = sh_History.Cells(Rows.Count, col).End(xlUp).Row
        If intlastrow = 1 Then 'Populate Row 1 or increment
            If sh_History.Cells(intlastrow, col).Value <> "" Then
                intlastrow = intlastrow   1
            End If
        Else
            intlastrow = intlastrow   1
        End If
        With sh_History.Cells(intlastrow, col)  ' With statements are GREAT for shortening code!
                .Value = target.Value   ' This handles what you already had -- the Date column.
                .Offset(0, -1).Value = target.Offset(0, -1).Value  ' This handles your Title column. 
        End With
    End If
End Sub

That works when I tested it.

Other suggestions

Comment 1

You have two lines that seem redundant:

If target.Column = 3 Then... and

col = target.Column

It's not wrong, but appears odd to me because you've done your test with the If statement and have already determined that the target.Column equals 3 at that point. So why not just set col = 3? In fact, with this code operating all by itself, I would set that variable when first declaring the variable.

Comment 2

I don't quite follow what you are trying to do with empty cells, and specifically this section:

        If intlastrow = 1 Then 'Populate Row 1 or increment
            If sh_History.Cells(intlastrow, col).Value <> "" Then
                intlastrow = intlastrow   1
            End If
        Else
            intlastrow = intlastrow   1
        End If

You don't want to put any values in Row 1 where you might be putting the header, "Date"; and you don't want to overwrite previous entries. I'm trying to think of a reason you can't delete that section above and just change this line:

intlastrow = sh_History.Cells(Rows.Count, col).End(xlUp).Row

to be this:

intlastrow = sh_History.Cells(Rows.Count, col).End(xlUp).Row 1

The line above will ensure you never get Row 1 nor will you overwrite a cell with data. The only question is if you are trying to track the history of when you EMPTY a cell, because the minimal change code above will produce a temporary record of the Title when you delete a date -- but then it gets overwritten by the next change.

Which brings us to...

Comment 3

Guessing that you might want to track every change -- even deletions -- then you need to track the last row that was written to in history. You could do that by checking the last row of both the Title and Date columns and pick the maximum. My preferred way would be to write a timestamp of each change and just use that column and row for incrementing.

Suggested solution:

With the above thoughts incorporated in re-written sub, here's what I think you want in a more succinct fashion:

Private Sub worksheet_change(ByVal target As Range)
        Dim col As Long
        Dim intlastrow As Long
        Dim sh_History As Worksheet
        
        col = 3  ' Set the var to 3 here and if you need to change it, only one spot needs updating.
        Set sh_History = ThisWorkbook.Sheets("Sheet2")  ' object variable set
        
        If target.Column = col Then ' Test target against desired column.
        
                intlastrow = sh_History.Cells(Rows.Count, col   1).End(xlUp).Row   1
'  Two changes in above line:
' 1). Incrementing the row by 1 right here so I can eliminate the previous IF statements.
' 2). I am adding a Timestamp column so you can track deletions, and to reference the Timestamp _
'       I am going to column D, or ' col   1 ' to ensure I find the last row.

                With sh_History.Cells(intlastrow, col)  ' With statements are GREAT for shortening code!
                        .Value = target.Value   ' This handles what you already had -- the Date column.
                        .Offset(0, -1).Value = target.Offset(0, -1).Value  ' This handles your Title column.
                        .Offset(0, 1).Value = Now()   ' This is the TimeStamp column.
                End With
                
        End If
        
End Sub

CodePudding user response：

It's good to also make sure your code can handle multi-cell changes:

Private Sub worksheet_change(ByVal target As Range)
    Dim rng As Range, c As Range
    
    Set rng = Application.Intersect(Me.Columns(3), target)
    If rng Is Nothing Then Exit Sub
    
    For Each c In rng.Cells
        Sheet4.Cells(Rows.Count, c.Column).End(xlUp).Offset(1, 0).Resize(1, 2).Value = _
          c.Offset(0, -1).Resize(1, 2).Value
    Next c

End Sub