Excel VBA Static Timestamp in Worksheet_Change event

Question

I am working on creating a log that will automatically populate a timestamp into Cell D, when data is initially entered into Cell C. Unfortunately I have hit a wall.

• When I enter data in Cell C, I am able to get the timestamp in Cell D, but if I make any changes to Cell C, the timestamp updates again.

• I need to make it function so that the timestamp will ONLY change in Cell D if Cell C is blank.

• If data already has been entered into Cell C, and a timestamp already has been loaded to Cell D, and I need to modify what's in cell C, I don't want the timestamp Cell D to change.

Hope that makes sense. VBA code is as follows:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rCell As Range
    Dim rChange As Range

    On Error GoTo ErrHandler
    Set rChange = Intersect(Target, Range("C:C"))
    If Not rChange Is Nothing Then
        Application.EnableEvents = False
        For Each rCell In rChange
            If rCell > "" Then
                With rCell.Offset(0, 1)
                    .Value = Now
                    .NumberFormat = "hh:mm:ss AM/PM mm/dd/yyyy"
                End With
            Else
                rCell.Offset(0, 1).ClearContents
            End If
        Next
    End If

ExitHandler:
    Set rCell = Nothing
    Set rChange = Nothing
    Application.EnableEvents = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Any guidance would be appreciated.

Answer 1

The following puts a timestamp into column D if there isn't one there when a value is typed into column C. If the value in column C is cleared, any existing timestamp in column D is also cleared. If an edit is made to an entry in column C, then no change is made to the existing timestamp.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("C"), Target.Parent.UsedRange) Is Nothing Then
        On Error GoTo Safe_Exit
        Application.EnableEvents = False
        Dim rng As Range
        For Each rng In Intersect(Target, Columns("C"), Target.Parent.UsedRange)
            If CBool(Len(rng.Value2)) And Not CBool(Len(rng.Offset(0, 1).Value2)) Then
                rng.Offset(0, 1) = Now
            ElseIf Not CBool(Len(rng.Value2)) And CBool(Len(rng.Offset(0, 1).Value2)) Then
                rng.Offset(0, 1) = vbNullString
            End If
        Next rng
    End If
Safe_Exit:
    Application.EnableEvents = True
End Sub

This routine will handle multiple cells as Target; typically when several rows of data is pasted into column C. It further restricts Intersection to the worksheet's UsedRange property so that processing is minimized when actions like row deletion are performed.

Answer 2

Seems simple enough. Am I missing something? Just check to ensure the cell is blank before you update it.

With rCell.Offset(0, 1)
    If .Value <> "" Then
        .Value = Now
        .NumberFormat = "hh:mm:ss AM/PM mm/dd/yyyy"
    End If
End With