Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 4 Or Target.Row < 5 Or Target.Count > 1 Then Exit Sub
History Target
End Sub
Private Sub History(myCell As Range)
Dim c As Range, arr() As String, x As Long, Flag As Boolean
Set c = myCell.Offset(, 2)
If c.Value = "" Then
c.Value = Format(Date, "DD.MM.YY:") & myCell.Value
Else
arr = Split(c.Value, vbLf)
For x = LBound(arr) To UBound(arr)
If Left(arr(x), 9) = Format(Date, "DD.MM.YY:") Then
arr(x) = Left(arr(x), 9) & myCell.Value
Flag = True
Exit For
End If
Next x
If Flag = False Then
ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
arr(UBound(arr)) = Format(Date, "DD.MM.YY:") & myCell.Value
End If
c.Value = Join(arr, vbLf)
End If
End Sub