BorderCollie
I’m a dog person. I have a Yellow Lab, but I’ve always wanted a Border Collie. They are amazing “workhorse”, acrobatic and athletic dogs. Maybe someday I’ll have some land and animals so a Border Collie will be more fitting.

In the meantime, today’s post is not about dogs and farm animals – its about Excel PivotTables.

I like Pivot Tables a lot! I always try to use Pivot Tables before another other solution, if possible, for reporting purposes. But Pivot Table formatting options may not cover the entire spectrum of how we would like to format our Pivots.
PT1_Med
For example, I would like to add cell borders to all Data Range and Row Label items, but not Headers and GrandTotals.
PT_wBorderNotes2
I tried some different PivotTable Styles, but none gave me exactly what I was looking for. In this screen shot, for example, I tried adding adding a border to first column.

ColumnStripe1

There are 2 problems with this:

  1. The Header Row and the Grand Total Row also have the Column Border applied
  2. There does not appear to be a way to apply the same format across all columns

Enter PivotTable Ranges and VBA

Excel PivotTables offer various Ranges within the PivotTable. Jon Peltier covers the various Ranges here, so I won’t recover the information. Make sure you check out Jon’s tutorial – excellent!

DataBodyRange

I colored the DataBodyRange in the PivotTable below with a little VBA
DataBodyRangeFinal

Sub HighlightDataBodyRange()
    'Color the DataBodyRange of a PivotTable

    Dim wb         As Workbook
    Dim ws         As Worksheet
    Dim pt         As PivotTable
    Dim rng        As Range
    Dim lngGrey    As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lngGrey = RGB(217, 217, 217)
    
    With ws
        For Each pt In ws.PivotTables
            Set rng = pt.DataBodyRange
            rng.Interior.Color = lngGrey
        Next pt
    End With
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Looks pretty good, except:

  1. The DataBodyRange includes the Grand Total Row
  2. The DataBodyRange does not include the Row Labels

RowRange

I colored the RowRange in the PivotTable below with a little VBA
RowRangeFinal

Sub HighlightRowRange()
    'Color the RowRange of a PivotTable

    Dim wb          As Workbook
    Dim ws          As Worksheet
    Dim pt          As PivotTable
    Dim rng         As Range
    Dim lngGrey     As Long
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lngGrey = RGB(217, 217, 217)
    
    With ws
        For Each pt In ws.PivotTables
            Set rng = pt.RowRange
            rng.Interior.Color = lngGrey
        Next pt
    End With
    
    Set rng = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Looks pretty good, except:

  1. The RowRange includes the Grand Total Row
  2. The RowRange includes the Header Row
  3. The RowRange does not include the DataBodyRange identified previously

I have an understanding of a couple of ranges and their shapes. Now I need to reshape the ranges and merge them together.

Resize A Range

RangeReshape

The heavy dashed line in the screen shot shows what the final shape of each range should be if the VBA code works correctly. I filled the resized Ranges with new colors to show that they have been properly resized.

RangesResizedColored

Here’s the Function I came up with for resizing the Ranges. I don’t like it very much, but it works. I think there should be an enumeration for the Range Types of the Excel PivotTable. Maybe there is and I’m not aware of it.

Private Function GetResizedRange(rng As Range, _
                                 strType As String) As Range

    Dim r           As Long
    Dim c           As Long
    
    With rng
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Select Case strType
        Case "RowRange"
           Set rng = rng.Offset(1).Resize(r - 2, c)
        Case "DataBodyRange"
            Set rng = rng.Resize(r - 1, c)
    End Select
    
    Set GetResizedRange = rng
    Set rng = Nothing

End Function

Borders

FinalCellBorders
The cell borders look great and the original stated objectives have been achieved. I added the cell borders with this sub:

Private Sub AddBorders(rng As Range)

    Dim lngGrey          As Long
    lngGrey = RGB(217, 217, 217)
    
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = lngGrey
    End With

End Sub

The Complete Code

Here’s the complete code so you can copy pate it in one swoop if you so desire:

Option Explicit
Sub AddCellBordersToPivot()
    'Color the DataBodyRange of a PivotTable

    Dim wb              As Workbook
    Dim ws              As Worksheet
    Dim pt              As PivotTable
    Dim rngType         As Range
    Dim rngRow          As Range
    Dim rngData         As Range
    Dim strRangeType    As String
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    
    With ws
        For Each pt In ws.PivotTables
            'RowRange
                Set rngType = pt.RowRange
                strRangeType = "RowRange"
                Set rngRow = GetResizedRange(rng:=rngType, _
                                             strType:=strRangeType)
                
            'DataBodyRange
                Set rngType = pt.DataBodyRange
                strRangeType = "DataBodyRange"
                Set rngData = GetResizedRange(rng:=rngType, _
                                              strType:=strRangeType)
                                             
            'Add borders
                Call AddBorders(rng:=rngRow)
                Call AddBorders(rng:=rngData)
                
        Next pt
    End With
    
    Set rngType = Nothing
    Set rngRow = Nothing
    Set rngData = Nothing
    Set ws = Nothing
    Set wb = Nothing
    
End Sub

Private Sub AddBorders(rng As Range)

    Dim lngGrey          As Long
    lngGrey = RGB(217, 217, 217)
    
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = lngGrey
    End With

End Sub

Private Function GetResizedRange(rng As Range, _
                                 strType As String) As Range

    Dim r           As Long
    Dim c           As Long
    
    With rng
        r = .Rows.Count
        c = .Columns.Count
    End With
    
    Select Case strType
        Case "RowRange"
           Set rng = rng.Offset(1).Resize(r - 2, c)
        Case "DataBodyRange"
            Set rng = rng.Resize(r - 1, c)
    End Select
    
    Set GetResizedRange = rng
    Set rng = Nothing

End Function

Tidy Up

    Final Thoughts

    That’s it for today. I’m a little surprised there is not an easier way to refer to the Ranges I had to reshape here. I think users would like to apply formats separate from Header Rows and Grand Total Rows. How do you handle these issues? Do you know of a way to achieve this formatting using PivotTable Styles that I was not able to find? Where’d I put the dog’s leash? Time for a walk.

    Downloads

    Download the file from SkyDrive. The file name is PivotTable_CellBorders.xlsm

, ,
Trackback

5 comments untill now

  1. […] Snyder couldn’t find a pivot table style that he liked, so he wrote a macro to format specific ranges in the […]

  2. Hey there would you mind stating which blog platform you’re
    working with? I’m planning to start my own blog in the near
    future but I’m having a difficult time deciding between BlogEngine/Wordpress/B2evolution and Drupal.
    The reason I ask is because your design and style seems different then most blogs and I’m looking for something completely unique.
    P.S My apologies for being off-topic but I had to ask!

  3. Justina,

    I am using a Managed WordPress Account hosted by GoDaddy.com. I am using the Coogee Theme

  4. […] PivotTable Cell Borders […]

  5. […] Bordering On The Edge [Excel PivotTables] […]

Add your comment now