Magically Format Tables in Excel using VBA

Excel Tables make analyzing data, a breeze. It surprises me that it is not used as often as it should. It automatically “includes” new data you add to your spreadsheets, it automatically drags down formulas for you, it automatically formats the tables for you. In addition to that, you can use structured references that make your formulas tractable without having to name each range. You can also link an Excel Table to your PowerPivot Model. For a comprehensive, yet concise list of stuff excel tables can do, I recommend reading through this page.

While excel tables are indispensable when it comes to analyzing data, they are not built for displaying data. They can’t handle merged cells. Also, they require the headers to be on the first row. Nonetheless, the core features of an excel table are very useful while developing dynamic spreadsheet applications. Consequently, I developed macros that mimic excel tables: naming ranges automatically, dragging down formulas and formats. However, this post is only about quickly formatting tables in your sheet.

I reckon that a table formatting procedure should be able to do the following

1. Add Fill Colours
2. Change Font Colours
3. Drag down Number Formats
4. Make Banded Rows and Columns; I am not a big fan of it though.
5. Add Borders
6. Differentiate between Headings and Data, and format them separately.

Here is the Code

Format tables that have headers on top

Sub FormatTableRowHeadings(Optional ByRef WhichRange As Range, _
    Optional ByVal HeaderFontBold As Boolean = False, _
    Optional ByVal HeaderFontColor As XlRgbColor = rgbBlack, _
    Optional ByVal HeaderFillColor As XlRgbColor = xlNone, _
    Optional ByVal ContentFontColor As XlRgbColor = rgbBlack, _
    Optional ByVal ContentFillColor As XlRgbColor = xlNone, _
    Optional ByVal ContentZebraTint As Double = 0)

'Declare Sub Level Variables and Objects
Dim Table As Range
Dim Header As Range
Dim Contents As Range
Dim EachCell As Range
Dim HeaderRows As Long
Dim TempInteger As Long
Dim Counter As Long

'Use the Active cell, if the user did not specify a range
If WhichRange Is Nothing Then
    Set WhichRange = Application.ActiveCell
End If

'Initialize Variables
HeaderRows = 1
'Include the region surrounding the Range as well
Set Table = WhichRange.CurrentRegion

'Check if there are merged cells in the Top Row, and remember
'the size
For Each EachCell In Table.Rows(1).Cells
    If EachCell.MergeCells Then
        TempInteger = EachCell.MergeArea.Rows.Count
        If TempInteger > HeaderRows Then
            HeaderRows = TempInteger
        End If
    End If
Next EachCell
'Set the Top Row, including its merged cells as the Table's
'Headings
Set Header = Range(Table.Item(1, 1), _
    Table.Item(HeaderRows, Table.Columns.Count))

'Apply the formatting to the header
If Not Header Is Nothing Then
    'Make the headings bold
    Header.Font.Bold = HeaderFontBold
    'Add Color to the font
    Header.Font.Color = HeaderFontColor
    'Add fill colours to the cells
    Header.Interior.Color = HeaderFillColor
End If

'Check if the current region has data. This prevents an error from
'occurring if the "table" is a single row header.
If Table.Rows.Count > HeaderRows Then
    Set Contents = Table.Offset(HeaderRows).Resize( _
        Table.Rows.Count - HeaderRows)
End If

'If the current region did have more than just a header, go ahead
'and format the data
If Not Contents Is Nothing Then
    'Drag down number formats
    If Contents.Rows.Count > 1 Then
        For Counter = 1 To Contents.Columns.Count
            On Error Resume Next
            Contents.Columns(Counter).Cells(1, 1).AutoFill _
                Contents.Columns(Counter).Cells, xlFillFormats
            On Error GoTo 0
        Next Counter
    End If
    'Add color to the font
    Contents.Font.Color = ContentFontColor
    'Add fill color to the cells
    Contents.Interior.Color = ContentFillColor
    'Add banding to the rows
    If Not ContentZebraTint = 0 Then
        For Counter = 2 To Contents.Rows.Count Step 2
            Contents.Rows(Counter).Cells. _
                Interior.TintAndShade = ContentZebraTint
        Next Counter
    End If
End If

End Sub

Format tables that have headers to the left

Sub FormatTableColumnHeadings(Optional ByRef WhichRange As Range, _
    Optional ByVal HeaderFontBold As Boolean = False, _
    Optional ByVal HeaderFontColor As XlRgbColor = rgbBlack, _
    Optional ByVal HeaderFillColor As XlRgbColor = xlNone, _
    Optional ByVal ContentFontColor As XlRgbColor = rgbBlack, _
    Optional ByVal ContentFillColor As XlRgbColor = xlNone, _
    Optional ByVal ContentZebraTint As Double = 0)

'Declare Sub Level Variables and Objects
Dim Table As Range
Dim Header As Range
Dim Contents As Range
Dim EachCell As Range
Dim HeaderColumns As Long
Dim TempInteger As Long
Dim Counter As Long

'Use the Active cell, if the user did not specify a range
If WhichRange Is Nothing Then
    Set WhichRange = Application.ActiveCell
End If

'Initialize Variables
HeaderColumns = 1
'Include the region Surounding the Range as well
Set Table = WhichRange.CurrentRegion

'Check if there are merged cells in the First Column, and
'remember the size
For Each EachCell In Table.Columns(1).Cells
    If EachCell.MergeCells Then
        TempInteger = EachCell.MergeArea.Columns.Count
        If TempInteger > HeaderColumns Then
            HeaderColumns = TempInteger
        End If
    End If
Next EachCell
'Set the First Column, including its merged cells as the Table's
'Headings
Set Header = Range(Table.Item(1, 1), _
    Table.Item(Table.Rows.Count, HeaderColumns))

'Apply the formatting to the header
If Not Header Is Nothing Then
    'Make the headings bold
    Header.Font.Bold = HeaderFontBold
    'Add Color to the font
    Header.Font.Color = HeaderFontColor
    'Add fill colours to the cells
    Header.Interior.Color = HeaderFillColor
End If

'Check if the current region has data. This prevents an error from
'occurring if the "table" is a single column header.
If Table.Columns.Count > HeaderColumns Then
    Set Contents = Table.Offset(, HeaderColumns).Resize(, _
        Table.Columns.Count - HeaderColumns)
End If

'If the current region did have more than just a header, go ahead
'and format the data
If Not Contents Is Nothing Then
    'Drag to the right, the number formats
    If Contents.Columns.Count > 1 Then
        For Counter = 1 To Contents.Rows.Count
            On Error Resume Next
                Contents.Rows(Counter).Cells(1, 1).AutoFill _
                    Contents.Rows(Counter).Cells, xlFillFormats
            On Error GoTo 0
        Next Counter
    End If
   'Add color to the font
    Contents.Font.Color = ContentFontColor
    'Add fill color to the cells
    Contents.Interior.Color = ContentFillColor
    'Add banding to the rows
    If Not ContentZebraTint = 0 Then
        For Counter = 2 To Contents.Columns.Count Step 2
            Contents.Columns(Counter).Cells. _
                Interior.TintAndShade = ContentZebraTint
        Next Counter
    End If
End If

End Sub

Add borders to a table

Sub AddTableBorders(Optional ByRef WhichRange As Range, _
    Optional ByVal TableLineStyle As XlLineStyle = xlContinuous, _
    Optional ByVal TableLineWeight As XlBorderWeight = xlThin, _
    Optional ByVal TableLineColor As XlRgbColor = rgbBlack, _
    Optional ByVal TableLineTint As Double = 0, _
    Optional ByVal TableEdgeLeft As Boolean = True, _
    Optional ByVal TableEdgeTop As Boolean = True, _
    Optional ByVal TableEdgeBottom As Boolean = True, _
    Optional ByVal TableEdgeRight As Boolean = True, _
    Optional ByVal TableInsideVertical As Boolean = True, _
    Optional ByVal TableInsideHorizontal As Boolean = True, _
    Optional ByVal TableDiagonalDown As Boolean = False, _
    Optional ByVal TableDiagonalUp As Boolean = False)

'Declare Sub Level Variables and Objects
Dim Table As Range
Dim WhichBorder As Border

'Use the Active cell, if the user did not specify a range
If WhichRange Is Nothing Then
    Set WhichRange = Application.ActiveCell
End If
'Include the region Surounding the Range as well
Set Table = WhichRange.CurrentRegion

'If the user set TableLineStyle to xlNone, reset all the
'border boolean markers to False
If TableLineStyle = xlNone Or TableLineWeight = xlNone Then
    TableEdgeLeft = False
    TableEdgeTop = False
    TableEdgeBottom = False
    TableEdgeRight = False
    TableInsideVertical = False
    TableInsideHorizontal = False
    TableDiagonalDown = False
    TableDiagonalUp = False
End If

'Go through each border and apply the formats if the use chose to
'have it in the table.

'Left Edge
Set WhichBorder = Table.Borders(xlEdgeLeft)
If TableEdgeLeft Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'Top Edge
Set WhichBorder = Table.Borders(xlEdgeTop)
If TableEdgeTop Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'Bottom Edge
Set WhichBorder = Table.Borders(xlEdgeBottom)
If TableEdgeBottom Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'Right Edge
Set WhichBorder = Table.Borders(xlEdgeRight)
If TableEdgeRight Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'All the vertical lines in between
Set WhichBorder = Table.Borders(xlInsideVertical)
If TableInsideVertical Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'All the Horizantal lines in between
Set WhichBorder = Table.Borders(xlInsideHorizontal)
If TableInsideHorizontal Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'I included the diagonal lines just to romove them if someone,
'edded it inadvertently.

'Diagonal Down Lines
Set WhichBorder = Table.Borders(xlDiagonalDown)
If TableDiagonalDown Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

'Diagonal Up Lines
Set WhichBorder = Table.Borders(xlDiagonalUp)
If TableDiagonalUp Then
    With WhichBorder
        .LineStyle = TableLineStyle
        .ColorIndex = TableLineColor
        .TintAndShade = TableLineTint
        .Weight = TableLineWeight
    End With
Else
    WhichBorder.LineStyle = xlNone
End If

End Sub

Illustrations

Sub ResetTableFormats()

    Call FormatTableRowHeadings
    Call AddTableBorders(, xlNone)

End Sub

Sub FormatRowCrimsonDark()

    Call FormatTableRowHeadings(, False, rgbWhite, RGB(45, 45, 45), _
            rgbWhite, rgbCrimson, 0.2)
    Call AddTableBorders

End Sub

Sub FormatRowGoldDark()

    Call FormatTableRowHeadings(, False, rgbWhite, RGB(45, 45, 45), _
            rgbBlack, rgbGold, 0.2)
    Call AddTableBorders

End Sub

Sub FormatColumnCrimsonDark()

    Call FormatTableColumnHeadings(, False, rgbWhite, RGB(45, 45, 45), _
            rgbWhite, rgbCrimson, 0.2)
    Call AddTableBorders

End Sub

Sub FormatColumnGoldDark()

    Call FormatTableColumnHeadings(, False, rgbWhite, RGB(45, 45, 45), _
            rgbBlack, rgbGold, 0.2)
    Call AddTableBorders

End Sub

Additional Notes about these procedures

1. These procedures use merged cells to differentiate between the headings and data.
2. You can specify fill and font colours for headings and data separately.
3. You may choose to make the headings bold and add banded rows.
4. The macro drags down the number formats.
5. I have declared the colour arguments as ‘XlRgbColor‘ enumerations, i.e. you will get a list of colours as soon as you hit comma key on your keyboard. You may also use the RGB function to specify colours, if you know exactly what colour you want.
6. I used the Interior.TintAndShade property of the Range object, to create banded Rows.
   1. The argument accepts any value between -1 and 1.
   2. Positive fractions make the colour lighter
   3. And negative fractions make the colour darker.

Download

Download the workbook and import its modules into your projects. I urge you to go ahead and read through the code. I have added in a lot of comments to help you understand what it does, for you may have to tweak it a little to fit your tables.

Go wild with the colours and share your themes here.