I want Excel to automatically insert the current date in column F when any changes are made in either column A or column D.

I found a similar solution that checks one column using Offset, but it doesn't work as expected - it moves the output rather than keeping the date in column F.

Video Reference: Excel Automatically Date and Time Stamp When Data is Entered but Don't Change When Data is Modified

In the video, only changes in the range A2:A10 trigger the timestamp. I need the script to check both A2:A10 and D2:D10 and place the updated date only in column F when a change occurs in either column.

How can I modify the VBA code to achieve this?

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim MyDataRng As Range
   Set MyDataRng = Range("A2:D10")
   If Intersect (Target, MyDataRng) Is Nothing Then Exit Sub
   On Error Resume Next
   Target.Offset(0, 5) = Now
End Sub

It looks through all the columns which is whatever, but most importantly it doesn't give the current date (Now) in the same column and offsets it.

I want Excel to automatically insert the current date in column F when any changes are made in either column A or column D.

I found a similar solution that checks one column using Offset, but it doesn't work as expected - it moves the output rather than keeping the date in column F.

Video Reference: Excel Automatically Date and Time Stamp When Data is Entered but Don't Change When Data is Modified

In the video, only changes in the range A2:A10 trigger the timestamp. I need the script to check both A2:A10 and D2:D10 and place the updated date only in column F when a change occurs in either column.

How can I modify the VBA code to achieve this?

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim MyDataRng As Range
   Set MyDataRng = Range("A2:D10")
   If Intersect (Target, MyDataRng) Is Nothing Then Exit Sub
   On Error Resume Next
   Target.Offset(0, 5) = Now
End Sub

It looks through all the columns which is whatever, but most importantly it doesn't give the current date (Now) in the same column and offsets it.

• excel
• vba
• formula

4 Answers 4

Try something like this code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyDataRng As Range
    Set MyDataRng = Range("A2:A10,D2:D10")
    If Intersect(Target, MyDataRng) Is Nothing Then Exit Sub
'    On Error Resume Next
    Cells(Target.Row, "F").Value = Now
End Sub

The basic code to solve your problem is:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim MyDataRng As Range
    Dim wks As Worksheet
    
    Set wks = Me
    Set MyDataRng = wks.Range("A2:D10")
    
    On Error GoTo ClearError ' Start error-handling routine
    
    If Target.CountLarge = 1 Then
        If Not Intersect(Target, MyDataRng) Is Nothing Then
            Application.EnableEvents = False
            wks.Cells(Target.Row, 5).Value = Now
            GoTo ProcExit
        End If
    End If

ProcExit:
    On Error Resume Next
    Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub

ClearError:
    MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit

End Sub

Please also have a look at Excel VBA Table to Uppercase When Leaving Cell for more in-depth discussion on the subject.

Let me to allow myself to present modified @Michal's code which is able to process the multiple cells change event:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim isr As Range, cc
  On Error GoTo ClearError
  Set isr = Intersect(Target, Range("A2:A10, D2:D10"))
  If isr Is Nothing Then Exit Sub
  Application.EnableEvents = False
  For Each cc In isr
    Cells(cc.Row, 6).Value = Now
  Next
  Application.EnableEvents = True
ProcExit:
  Exit Sub
ClearError:
  MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
      & Err.Description, vbCritical
  Resume ProcExit
End Sub

place this in the worksheet module where you want the updating to happen and adapt the cokumns to monitor and where the date should end up

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MonitorCols As Variant, UpdateCol As String, DateFormat As String
    Dim LastRow As Long, CheckRange As Range, Cell As Range
    Dim ws As Worksheet
    Set ws = Me ' Reference the current worksheet

    ' Configuration variables
    MonitorCols = Array("A", "D") ' Columns to monitor for changes
    UpdateCol = "F" ' Column where the timestamp will be placed
    DateFormat = "yyyy-mm-dd HH:MM:SS" ' Date format (customizable)

    ' Determine the last used row dynamically across monitored columns
    LastRow = 1 ' Default in case sheet is empty
    Dim Col As Variant
    For Each Col In MonitorCols
        LastRow = Application.WorksheetFunction.Max(LastRow, ws.Cells(ws.Rows.Count, Col).End(xlUp).Row)
    Next Col

    ' Build dynamic range for monitored columns
    For Each Col In MonitorCols
        If CheckRange Is Nothing Then
            Set CheckRange = ws.Range(Col & "2:" & Col & LastRow)
        Else
            Set CheckRange = Union(CheckRange, ws.Range(Col & "2:" & Col & LastRow))
        End If
    Next Col

    ' Exit if no relevant changes were made
    If Intersect(Target, CheckRange) Is Nothing Then Exit Sub

    Application.EnableEvents = False ' Prevent recursive calls

    ' Update timestamp in the corresponding row of the update column
    For Each Cell In Intersect(Target, CheckRange)
        With ws.Cells(Cell.Row, UpdateCol)
            .Value = Now
            .NumberFormat = DateFormat
        End With
    Next Cell

    Application.EnableEvents = True
End Sub