Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo ReEnable
With Range("A1:BE500")
If Not Intersect(.Cells, Target) Is Nothing Then
For Each cell In Intersect(.Cells, Target)
If cell.Value <> Empty Then
If cell.Column Mod 2 = 0 Then
cell.Offset(, 1).Value = Now
End If
End If
Next cell
End If
End With
ReEnable:
Application.EnableEvents = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox Err.Description, vbCritical, "Error " & Err.Number
End Sub
Bookmarks