CODEWITHSUNDEEP
excelvbadatetime
Chris Macaluso
Chris Macaluso

Reputation: 1482

Generate datetime when entry made in cell

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

Upvotes: 0

Views: 106

Answers (2)

JvdV
JvdV

Reputation: 75850

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.

Upvotes: 2

BigBen
BigBen

Reputation: 50008

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

Upvotes: 5

Related Questions