Create a new datestamp every time a certain cell changes? - excel

Question

I have a cell that states the status of a project, and this status will change frequently.
Whenever the status gets changed, I would like a row to state the time the status was changed and the name of the new status.
I have next to no experience with VBA, so any assistance would be greatly appreciated. So far I have this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = 4 Then
Target.Offset(10, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")
End If
End Sub
This code successfully lists the time in cell G7 whenever the status contained in cell D4 changes, but it always repopulates the same cell, I would like each successive status change to list the date stamp in cell G8, then G9, then G10, and so on.
It also doesn't list what the status cell D4 is changed too, ideally I would like that to be listed in F7, then F8, then F9, and so on.

Answer 1

If you are only interested in a Worksheet_Change on cell D4, you can use the Intersect method shown below
To start a running list, you will need to determine that last used cell in Column G and offset accordingly
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4")) Is Nothing Then
Dim LR As Long: LR = Range("G" & Rows.Count).End(xlUp).Offset(1).Row
Target.Offset(LR - Target.Row, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")
Target.Offset(LR - Target.Row, 4) = Target
End If
End Sub

Answer 2

Please try this.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Tgt As String = "D4" ' monitored cell
Const FirstRecord As Long = 7 ' change as required
Const Fmt As String = "yyyy-mm-dd hh:mm:ss"
Dim Rl As Long ' last used row
If Target.Address = Range(Tgt).Address Then
Application.EnableEvents = False
Rl = Application.WorksheetFunction.Max( _
Cells(Rows.Count, "F").End(xlUp).Row + 1, FirstRecord)
With Cells(Rl, "G")
.Value = Now()
.NumberFormat = Fmt
Target.Copy Destination:=.Offset(0, -1)
End With
Application.EnableEvents = True
End If
End Sub