Date to Age Calculator: Turn Placed-In-Service Dates Into Years and Months Instantly

TL;DR: You have 200 fixed assets with placed-in-service dates. The partner wants a depreciation schedule showing the age of each asset as of 12/31/2026. This macro asks for the as-of date, lets you click the date column, and inserts a new column to the right showing every age in “Xy Ym” format. Original data stays untouched.

#Prerequisites & Setup

What you’ll need:

• Excel 2016+ (desktop)
• A worksheet with a column of dates (fixed asset placed-in-service dates, employee hire dates, contract start dates — anything that’s a real Excel date)
• Dates stored as actual Excel date values (serial numbers), not text that looks like a date

Limitations:

• Works on the active sheet only — select the right tab before running
• Dates must be in a single column (no scattered date cells)
• Blank cells and non-date values are skipped and reported
• The inserted column pushes existing columns to the right — formulas referencing those columns will shift automatically
• Age is calculated in calendar months, not 30-day months — DateDiff("m") uses the actual calendar

#The Macro

Option Explicit

Sub DateToAgeCalculator()
    ' ── Date to Age Calculator ─────────────────────────
    ' Asks for an as-of date, then lets the user select
    ' a column of dates. Inserts a new column to the
    ' right showing the age of each date in "Xy Ym"
    ' format (e.g., "3y 4m"). Skips blanks and non-date
    ' values, reporting both in the final summary.
    ' ────────────────────────────────────────────────────

    ' ── Configuration ──────────────────────────────────
    Const HEADER_ROW As Long = 1

    ' ── State management ───────────────────────────────
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' ── Variables ──────────────────────────────────────
    Dim ws As Worksheet
    Dim asOfDate As Date
    Dim dateInput As String
    Dim dateCol As Range
    Dim colNum As Long, lastRow As Long
    Dim r As Long, months As Long
    Dim agedCount As Long, skippedCount As Long

    ' ── Error handling ─────────────────────────────────
    On Error GoTo CleanUp

    Set ws = ActiveSheet

    ' ── Step 1: Get as-of date ─────────────────────────
    dateInput = InputBox( _
        "Enter the as-of date (e.g., 12/31/2026):", _
        "As-Of Date", Format(Date, "mm/dd/yyyy"))
    If dateInput = "" Then GoTo CleanUp

    If Not IsDate(dateInput) Then
        MsgBox """" & dateInput & """ is not a valid date. " & _
               "Use mm/dd/yyyy format.", vbExclamation, "Invalid Date"
        GoTo CleanUp
    End If
    asOfDate = CDate(dateInput)

    ' ── Step 2: Select the date column ─────────────────
    On Error Resume Next
    Set dateCol = Application.InputBox( _
        "Click any cell in the column that contains dates:", _
        "Select Date Column", Type:=8)
    On Error GoTo CleanUp

    If dateCol Is Nothing Then GoTo CleanUp

    colNum = dateCol.Column
    lastRow = ws.Cells(ws.Rows.Count, colNum).End(xlUp).Row

    If lastRow <= HEADER_ROW Then
        MsgBox "No data found in column " & ColLetter(colNum) & _
               " below the header row.", vbExclamation
        GoTo CleanUp
    End If

    ' ── Step 3: Insert new column to the right ─────────
    ws.Columns(colNum + 1).Insert Shift:=xlToRight
    ws.Cells(HEADER_ROW, colNum + 1).Value = _
        "Age (as of " & Format(asOfDate, "mm/dd/yyyy") & ")"
    ws.Cells(HEADER_ROW, colNum + 1).Font.Bold = True

    ' ── Step 4: Calculate ages ─────────────────────────
    agedCount = 0
    skippedCount = 0

    For r = HEADER_ROW + 1 To lastRow
        If IsEmpty(ws.Cells(r, colNum)) Then
            skippedCount = skippedCount + 1
        ElseIf IsDate(ws.Cells(r, colNum).Value) Then
            months = DateDiff("m", ws.Cells(r, colNum).Value, asOfDate)
            ws.Cells(r, colNum + 1).Value = _
                (months \ 12) & "y " & (months Mod 12) & "m"
            agedCount = agedCount + 1
        Else
            ws.Cells(r, colNum + 1).Value = "(not a date)"
            skippedCount = skippedCount + 1
        End If
    Next r

    ' ── Step 5: Format the output column ───────────────
    ws.Columns(colNum + 1).AutoFit

    ' ── Step 6: Summary ────────────────────────────────
    Dim msg As String
    msg = "Aged " & agedCount & " date(s)." & vbCrLf & _
          skippedCount & " skipped (blank or non-date)." & vbCrLf & _
          "Output in column " & ColLetter(colNum + 1) & "."

    MsgBox msg, vbInformation, "Done"

CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
               vbCritical, "Macro Error"
    End If
End Sub

' ── Helper: Convert column number to letter ────────────
Private Function ColLetter(colNum As Long) As String
    ColLetter = Split(Cells(1, colNum).Address(True, False), "$")(0)
End Function

#How It Works

#Two InputBoxes, no code editing

The macro uses two prompts before it does anything. The first is a standard InputBox — type the as-of date in mm/dd/yyyy format. It defaults to today’s date so you can just press Enter if you’re aging as of now. The IsDate check catches typos like “12/32/2026” before the macro starts writing.

The second prompt uses Application.InputBox(Type:=8) — the mouse-select variant. Click any cell in your date column and Excel captures the range. The macro extracts just the column number, so it doesn’t matter which row you click.

Set dateCol = Application.InputBox( _
    "Click any cell in the column that contains dates:", _
    "Select Date Column", Type:=8)
colNum = dateCol.Column

If the user cancels either prompt, GoTo CleanUp exits without touching the worksheet.

#DateDiff does the heavy lifting

months = DateDiff("m", ws.Cells(r, colNum).Value, asOfDate)
ws.Cells(r, colNum + 1).Value = _
    (months \ 12) & "y " & (months Mod 12) & "m"

DateDiff("m", ...) returns the number of calendar-month boundaries between two dates. An asset placed in service on March 15, 2023, aged as of December 31, 2026, crosses 45 month boundaries — that’s 3 years and 9 months.

The integer division (months \ 12) and modulo (months Mod 12) split the total months cleanly. No floating-point math, no rounding issues.

An important subtlety: DateDiff("m") counts month boundaries, not 30-day intervals. An asset placed in service on January 31 aged as of February 1 returns “0y 1m” even though only one day passed. For tax depreciation schedules this is almost always the desired behavior — MACRS half-year and mid-quarter conventions care about which month, not the exact day count.

#Non-destructive by design

The macro inserts a new column to the right of the date column and writes results there. It never modifies the dates themselves or any other data. If you run it on the wrong column, delete the inserted column and run again. Excel’s column-insert behavior automatically updates any formulas that reference shifted columns, so your cross-sheet references stay intact.

#Three things it skips

Blank cells. Not every row has a placed-in-service date — maybe the asset was disposed, or the row is a section divider. Blank cells increment the skip count and get no output.

Non-date values. A cell containing “Various” or “N/A” instead of a date gets the label (not a date) in the output column so you can see at a glance which cells need attention.

The header row. Row 1 is assumed to be headers and is never processed — it gets the output column header instead. Change HEADER_ROW if your sheet has headers in a different row.

#The output header tells you what you did

ws.Cells(HEADER_ROW, colNum + 1).Value = _
    "Age (as of " & Format(asOfDate, "mm/dd/yyyy") & ")"

The column header includes the as-of date so six months from now, when you reopen the workbook, you know exactly which date was used. No mystery “Age” column with unknown provenance.

#Why the message box lists the output column

msg = "Aged " & agedCount & " date(s)." & vbCrLf & _
      skippedCount & " skipped (blank or non-date)." & vbCrLf & _
      "Output in column " & ColLetter(colNum + 1) & "."

If you expected 187 results and got 185, the skip count tells you two cells need attention. The column letter in the message saves you from scrolling right to find the output.

#Adapt It