If Intersect(Targe, Range("A9:A5557"), Range("F9:F5557")) is nothing...
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A9:A5557")) Is Nothing Then
Target.Offset(, 4) = IIf(Target = "", "", Now)
ElseIf Not Intersect(Target, Range("F9:F5557")) Is Nothing Then
Target.Offset(, 5) = IIf(Target = "", "", Now)
End If
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
Select Case Target.Row
Case 9 To 5557
Select Case Target.Column
Case 1, 6
If Target = "" Then
Target.Offset(, (Target.Column - 1) / 5 + 4).ClearContents
Else
Target.Offset(, (Target.Column - 1) / 5 + 4) = Now
End If
End Select
End Select
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objRange As Range, lngOffs As Long, objCell As Range
Set objRange = Intersect(Target, Union(Range("A9:A5557"), Range("F9:F5557")))
If Not objRange Is Nothing Then
For Each objCell In objRange
With objCell
lngOffs = 4
If .Column = 6 Then lngOffs = 5
If .Value = "" Then
.Offset(, lngOffs).ClearContents
Else
.Offset(, lngOffs) = Now
End If
End With
Next
Set objRange = Nothing
End If
End Sub