'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]
Never use
On Error Resume Nextwithout 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.Use
Offset()to make dynamic column moves.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.NumberFormatto format it the way you want!Note that
Targetis 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, thenTargetcontains all those cells. So you need to make sure to loop through all changed cells.Think of what should happen if data is deleted. Should the timestamp get deleted as well? If not remove the
If Cell.Value2 = vbNullString Thenpart 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ᴇʜ |
