Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    If Intersect(Range("B2:B" & Rows.Count), Target) Is Nothing Then Exit Sub
    On Error GoTo ReEnable
    Application.EnableEvents = False
    For Each cell In Intersect(Range("B2:B" & Rows.Count), Target)
        If cell.Value <> "" Then cell.Offset(, -1).Value = Date
    Next cell
ReEnable:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description, vbCritical, _
                                   "Error in Worksheet_Change Procedure"
End Sub