VBA Macro: Format a Results Table

Option Explicit

Sub FormatResultsTable()
    ' Format the currently selected range as a results table.
    ' Assumes the FIRST row of the selection is the header.

    Dim rng As Range
    Set rng = Selection

    If rng.Rows.Count < 2 Or rng.Columns.Count < 2 Then
        MsgBox "Select at least a 2x2 range including the header row.", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Dim hdr As Range
    Set hdr = rng.Rows(1)

    ' Header style — dark navy fill, white bold
    With hdr
        .Interior.Color = RGB(31, 41, 55)
        .Font.Color = RGB(255, 255, 255)
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With

    ' Borders on the whole range
    With rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .Color = RGB(170, 170, 170)
    End With

    ' Number format: 4 decimals on numeric columns
    Dim col As Range
    For Each col In rng.Columns
        If IsNumeric(col.Cells(2, 1).Value) Then
            col.NumberFormat = "0.0000"
        End If
    Next col

    ' Freeze top row at the header
    Dim hdrAddr As String
    hdrAddr = hdr.Cells(1).Offset(1, 0).Address(False, False)
    ActiveWindow.FreezePanes = False
    Range(hdrAddr).Select
    ActiveWindow.FreezePanes = True

    ' Autofit columns
    rng.Columns.AutoFit

    ' Re-select original range
    rng.Select

    Application.ScreenUpdating = True
End Sub