Private Sub Worksheet_Change(ByVal Target As Range)
Dim RNG As Range, cell
Set RNG = ActiveSheet.Range("A2:A10")
If Not Intersect(Target, RNG) Is Nothing Then
For Each cell In RNG
If Len(cell) > 0 And IsEmpty(cell.Offset(0, 1)) Then
cell.Offset(0, 1) = Now()
End If
Next cell
End If
End Sub