'Macro that references one cell in a column to populate another cell in a column

I have the following macro (see below):

I'm trying to have this apply to the other columns. Currently, if I populate column "C", it places a timestamp in in "Q". I need this to continue so that if "D" is populated, a timestamp is entered in "R", then "E" to populate "S", etc... all the way to "P" populating "DD".

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim xRInt As Integer
    Dim xDStr As String
    Dim xFStr As String
    On Error Resume Next
    xDStr = "C" 'Data Column
    xFStr = "Q" 'Timstamp Column
    If (Not Application.Intersect(Me.Range(xDStr & ":" & xDStr), Target) Is Nothing) Then
           xRInt = Target.Row
           Me.Range(xFStr & xRInt) = Format(Now(), "mm/dd/yyyy hh:mm:ss")
    End If

End Sub


Solution 1:[1]

  1. Never use On Error Resume Next without proper error handling. This line hides all error messages, but the errors still occur. If you don't know which errors you get, you cannot fix them if you don't fix them your code obviously cannot work as expected.

  2. Use Offset() to make dynamic column moves.

  3. Never ever use Format() to write a date/time! This will write a text into the cell that looks like a date, but it is only text/string and no date. Instead write the real numeric date and only use .NumberFormat to format it the way you want!

  4. Note that Target is not only one single cell but can be multiple cells. For example if you copy paste a range of data, or if you select a range of data and press delete, then Target contains all those cells. So you need to make sure to loop through all changed cells.

  5. Think of what should happen if data is deleted. Should the timestamp get deleted as well? If not remove the If Cell.Value2 = vbNullString Then part and only keep what is in the else part.

So you would end up with something like this:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const TimestampColumnOffset As Long = 14  ' define the offset from column C to Q this is 14 columns to the right

    Dim WatchedDataRange As Range  ' define the range to watch out for changes
    Set WatchedDataRange = Me.Range("C:P")
    
    Dim AffectedRange As Range  ' the range where data actually was changed
    Set AffectedRange = Intersect(WatchedDataRange, Target)
    
    If Not AffectedRange Is Nothing Then  ' only run if data in the WatchedDataRange was changed
        Dim Cell As Range
        For Each Cell In AffectedRange.Cells  ' loop through all cells that were changed
            With Cell.Offset(ColumnOffset:=TimestampColumnOffset)  ' move from changed column 14 to the right
                If Cell.Value2 = vbNullString Then
                    ' delete timestamp if data is deleted
                    .Value2 = vbNullString
                Else
                    ' write timestamp if data is written
                    .Value2 = Now()  ' write a real numeric date/time
                    .NumberFormat = "mm/dd/yyyy hh:mm:ss"  ' format it so it looks as you desire
                End If
            End With
        Next Cell
    End If
End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Pᴇʜ