Excel Spreadsheet with Auto Date Column

In the past, several people have asked me if there is a way to get Microsoft Excel to automatically fill in today’s date in a column. These people have tried entering formula with the =TODAY() function only to find that it updates the cell to the current date each time the spreadsheet is opened. What they really want is an easy way to insert today’s date as a static date value and not a formula, and Excel contains a keyboard shortcut to do that. To insert the current date in an Excel spreadsheet, use the Ctrl-; keyboard shortcut (press and hold the ctrl key and while holding the ctrl key press and release the semicolon key).

The keyboard shortcut is quick and works well, but is there an easier way to get Excel to enter a date in a spreadsheet? Is there a way for a user to enter data in a column and Excel will automatically enter today’s date in a different column in the same row? There may be some built-in functionality in Excel that will do that, but I am unaware of it. So, I wrote a short VBA macro that will fill in a date column.

Download this Excel file, open it in Excel, and enable macros. Then you will be able to enter anything in columns B, C, or D, and Excel will automatically enter today’s date in column A of the same row.

Screenshot of a Microsoft Excel spreadsheet where the current date
is automatically entered into cells in column A.

You can view the VBA macro by pressing Alt-F11 and then double clicking on "Sheet1". I also copied the VBA macro below. If you want to change the location of the date column, then change the value of dateCol variable. For example if you want Excel to automatically enter the current date into column B, then change dateCol to 2. In other words change line 8 of the macro to be

    dateCol = 2

If you want to change the location of cells that cause Excel to enter a date, then change the value of keyCells. For example, if you want any data entered into columns C, D, and E, then change keyCells to "C1:E32765". In other words change line 13 of the macro to be

    Set keyCells = target.Worksheet.Range("C1:E32765")

Warning: don’t change the dateCol or the keyCells so that they overlap. For example don’t change dateCol to 3 and leave keyCells as "B1:D32765" because 3 means column C and B1:D3275 includes column C. In other words they overlap. Doing this will probably cause Excel to freeze or crash.

Option Explicit


Private Sub Worksheet_Change(ByVal target As Range)
    ' dateCol contains the index of the column where
    ' this macro will enter the current date.
    Dim dateCol As Integer
    dateCol = 1

    ' keyCells contains the range of cells that when
    ' they are changed will cause a date to be entered.
    Dim keyCells As Range
    Set keyCells = target.Worksheet.Range("B2:D32765")

    ' section contains the intersection of the keyCells
    ' and target ranges.
    Dim section As Range
    Set section = Application.intersect(keyCells, target)

    If Not section Is Nothing Then
        If WorksheetFunction.CountA(section) > 0 Then
            Application.EnableEvents = False
            InsertDate dateCol, section
            Application.EnableEvents = True
        End If
    End If
End Sub


Private Sub InsertDate(dateCol As Integer, ByRef section As Range)
    Dim startRow, endRow, startCol, endCol As Integer
    Dim row As Integer
    Dim dateCell, otherCells As Range

    startRow = section.row
    endRow = startRow + section.Rows.count - 1
    startCol = section.Column
    endCol = startCol + section.Columns.count - 1

    For row = startRow To endRow
        Set dateCell = Cells(row, dateCol)

        ' If the date cell is empty then check if
        ' the other cells in the row are not empty.
        If dateCell.Value = "" Then
            Set otherCells = Range( _
                    Cells(row, startCol), Cells(row, endCol))

            ' If the date cell is empty and at least one
            ' of the key cells in the same row is not
            ' empty, then enter a date in the date cell.
            If WorksheetFunction.CountA(otherCells) > 0 Then
                dateCell.Value = Date
            End If
        End If
    Next row
End Sub

Excel Spreadsheet with Auto Date Column

Further Reading