asked on

Excel VBA Code to Populate Adjacent Cells with Date and Time

Hello,

I have an Excel spreadsheet that I would like to have the date and time automatically populate into cells when data is entered. I have columns A through G. I would like the date to populate in column B and the time to populate in column C any time something is entered in column A. I would also like the date and time to clear from B and C if the data is deleted.

I had some VBA code to do this and it worked perfectly in Office 2010 (64-bit) but did not translate to other computers well, for some reason. I need this code to be portable and compatible with multiple versions of Office (let's just say 2007 and up).

yahooooo

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("A:A")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        Range(Target.Address).Offset(0, 2) = Time
        Range(Target.Address).Offset(0, 1) = Date
    End If
End Sub

Open in new window

street9009

ASKER

Is there any way to make B and C clear themselves when A is cleared?

ASKER CERTIFIED SOLUTION

yahooooo

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

street9009

ASKER

Thanks

yahooooo

i added a line (row13 below) to enable you deleting more then one cell a time

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim lastrow As Long, i As Long
    
    Set KeyCells = Range("A:A")
    
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
        Range(Target.Address).Offset(0, 2) = Time
        Range(Target.Address).Offset(0, 1) = Date
        For i = 2 To lastrow
            On Error Resume Next
            If Range(Target.Address) = vbNullString Then
                Range(Target.Address).Offset(0, 1) = vbNullString
                Range(Target.Address).Offset(0, 2) = vbNullString
            End If
        Next
    End If
End Sub

Open in new window