Generate datetime when entry made in cell

Question

I have code which should display the date in column A whenever something is entered in column B.

I enabled macros in security settings.

The VBA code is in ThisWorkbook under the project because I want the same thing to happen on every sheet.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
 ByVal Source As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = -1
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

Ahh, I see that now thank you. I've adjusted the original code but it still does not execute? — Chris Macaluso, Nov 15 '19 at 14:06
Check that events are enabled: `Application.EnableEvents = True` in the Immediate Window. Also, change `Application.ActiveSheet` to `Sh`. And change `ByVal Souce as Range` to `ByVal Target As Range`. — BigBen, Nov 15 '19 at 14:07
I've added `Application.EnableEvents = True` to the Immediate window, when I type `Application.ActiveSheet = Sh` it says `Run-time error '438: Object does not support this property or method`? — Chris Macaluso, Nov 15 '19 at 14:12
In the line `Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)`. — BigBen, Nov 15 '19 at 14:12
Ok, changed to `Set WorkRng = Intersect(Sh.Range("B:B"), Target)` but hwen i fill column B it generates `Run-time error '424': Object Required` — Chris Macaluso, Nov 15 '19 at 14:16
Did you change `ByVal Source as Range` to `ByVal Target as Range`? Also - add `Option Explicit` to the top of the module. — BigBen, Nov 15 '19 at 14:17
I just did...missed that the first time. It's working! Thank you! Wow I missed a lot of stuff :/ You should post an answer for the rep if you want! — Chris Macaluso, Nov 15 '19 at 14:19
One last question for you if you know, after testing I made it a protected sheet but got a runtime error upon testing again. After turning off the protection (back to original state) it does not work again now? Any idea why this happens? — Chris Macaluso, Nov 15 '19 at 14:22
@55thSwiss - because on an error, events don't get re-enabled. — BigBen, Nov 15 '19 at 14:28

score 5 · Accepted Answer · answered Nov 15 '19 at 14:22

A couple of changes:

1) First, you need(ed) to change to the workbook level event: the Workbook.SheetChange event.

2) Then change Application.ActiveSheet to Sh.

3) Make sure that the parameter is named Target if you're using Target within the code body.

4) Add some error handling to make sure events always get re-enabled:

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
                                 ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Sh.Range("B:B"), Target)
    xOffsetColumn = -1
    If Not WorkRng Is Nothing Then
        On Error GoTo SafeExit
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
    End If

SafeExit:
    Application.EnableEvents = True
End Sub

JvdV · Answer 2 · 2019-11-15T14:44:42.893

2

Something for you to consider (if you desire so) is to catch Now before you Loop to prevent different values. In such case you might not even want a loop at all. Consider to replace:

For Each Rng In WorkRng
    If Not VBA.IsEmpty(Rng.Value) Then
        Rng.Offset(0, xOffsetColumn).Value = Now
        Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
    Else
        Rng.Offset(0, xOffsetColumn).ClearContents
    End If
Next

With:

'Non empty cells with constants
If Application.CountA(WorkRng) > 0 Then
    Set Rng = WorkRng.SpecialCells(xlCellTypeConstants).Offset(0, -1)
    Rng.Value = Now
    Rng.NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If

And:

'Empty Cells
If Application.CountBlank(WorkRng) > 0 Then
    WorkRng.SpecialCells(xlCellTypeBlanks).Offset(0, -1).ClearContents
End If

You could implement this within the answer given by @BigBen if you will.

edited Nov 15 '19 at 14:44

answered Nov 15 '19 at 14:36

JvdV

70,606
8
39
70

A slight wrinkle that I thought of while responding to [this question](https://stackoverflow.com/questions/58883891/fill-cells-based-on-value-in-adjacent-cell). You'd need to handle the possibility of a formula being entered in column B too, right? – BigBen Nov 15 '19 at 22:23
Yes you would, but since OP was using `IsEmpty` I thought it would be fine. @BigBen – JvdV Nov 15 '19 at 22:24
Yeah I'm guessing so too, it was just from that other question (when OP was in fact using formulas instead of values) that I had the idea :) Still wish I could upvote another time (plus I don't see how my answer merits as many votes as it got). – BigBen Nov 15 '19 at 22:27
It's all good @Bigben. Your answer answers Op's question therefor worthy upvotes. I'll have a look at the linked answer tomorrow if you wish. Maybe we can come up with something =). I see u used `Evaluate` to return the array wich would be my goto also at first glance. – JvdV Nov 15 '19 at 22:30

Generate datetime when entry made in cell

2 Answers2