[SOLVED] Trying to set a date (Now) when a value is entered in a certain range

Trying to set a date (Now) when a value is entered in a certain range

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

Solution

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