CODEWITHSUNDEEP
excelvbadatestamp
user1556274
user1556274

Reputation: 37

Create a new datestamp every time a certain cell changes?

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.

Upvotes: 3

Views: 125

Answers (2)

Variatus
Variatus

Reputation: 14373

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

Upvotes: -1

urdearboy
urdearboy

Reputation: 14580

  1. If you are only interested in a Worksheet_Change on cell D4, you can use the Intersect method shown below
  2. 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

Upvotes: 2

Related Questions