I'm trying to get a date (now) in a cell when a value is added in other cell. I'm looking to work these by Column. One gets the value and the other one should get the date. This is being applied to a Table and kind of work but when trying to add new rows to my table the macro creates new columns a applies the date to all the rows created.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyData As Range
Dim MyDataRng As Range
Set MyDataRng = ActiveSheet.ListObjects("SRFPurchases").ListColumns("Syteline/MTK Requisition").DataBodyRange
If Intersect(Target, MyDataRng) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Offset(0, 1) = "" Then
Target.Offset(0, 1) = Now
End If
For Each MyData In MyDataRng
If MyData = "" Then
MyData.Offset(0, 1).ClearContents
End If
Next MyData
End Sub
EDIT: updated to handle >1 pair of entry/timestamp columns
EDIT2: only add a timestamp if one doesn't already exist
Try this out:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lc As ListColumns
Set lc = Me.ListObjects("SRFPurchases").ListColumns 'the listobject columns
CheckEntries Target, lc("Syteline/MTK Requisition").DataBodyRange, _
lc("TimeStamp").DataBodyRange
CheckEntries Target, lc("Other Info").DataBodyRange, _
lc("TimeStamp2").DataBodyRange
End Sub
'If Target contains any cells in `rngEntry` then check to see if a timestamp
' is needed in the range `rngTimestamp`
Sub CheckEntries(Target As Range, rngEntry As Range, rngTimestamp As Range)
Dim c As Range, cTS As Range, rng As Range
Set rng = Application.Intersect(Target, rngEntry) 'changes in tracked column?
If rng Is Nothing Then Exit Sub 'no changes to track
For Each c In rng.Cells 'check each tracked cell
Set cTS = Application.Intersect(c.EntireRow, rngTimestamp) 'timestamp cell
If Len(c.Value) > 0 Then 'any value?
'cTS.Value = Now 'add timestamp every update
If Len(cTS.Value) = 0 Then cTS.Value = Now 'or first entry only
Else
cTS.ClearContents
End If
Next c
End Sub