how to annotate pivot tables?

[miconian]

My users spend a lot of time in large pivot tables that are set up in compact view, expanding and collapsing fields by clicking on the plus and minus symbols. As they do this, they want to make notes about individual line items.

However, this is difficult because a) there is nowhere that allows the user to make notes inside the pivot table, and b) if they make notes outside the table, the row their note corresponds to will change when fields are collapsed and expanded. Also, it seems that Excel does not allow comments to be added to cells within pivot tables.

Surely others have had this problem. Is there some obvious workaround I'm missing?

thanks!

 

[Jerry Sullivan]

That's an interesting question. Due to the dynamic nature of the PivotTable, I don't think there is a simple solution to do what you describe.

Excel does allow you to add comments to the Cells of the PivotTables.
"Add Comment" does not appear in the standard Right-Click menu for PivotTable Cells; however you can go to the Review Tab of the Ribbon and pick "Add Comment".

That being said, this isn't very useful because the Comments stay with those Cells when the data is reorganized or filtered, so it has the same limitations of placing notes in the Column outside the PivotTable.

VBA could probably be used to enable notes to "move" with the data or labels they reference, using a syntax like GETPIVOTDATA to key on a combination of field references. That would be somewhat complex and only solve part of the problem.

With a PivotTable, the report can change to show entirely different summaries and views of the source data (changing ReportPages, Filtering, Changing Position of RowField Labels, Grouping, Adding/Removing Fields). What would you want to happen to the comments when the data they reference is no longer displayed?

 

[miconian]

"What would you want to happen to the comments when the data they reference is no longer displayed?"

Well, I would want them to disappear until the data they referenced was shown again.

Of course, there is a small downside to that, in that the user might forget the comments existed, because they would be hidden. So in a perfect world, there would be a way of showing from a higher-level field that there were comments available to be read upon expansion.

 

[Jerry Sullivan]

I could give that a try using VBA later today.

What would be your preference for the location of the annotation - would you want those placed in the first column to the right of the PivotTable, or as Comments in the Cells?

I'd suggest starting with one annotation per row (tied to RowField and PageField combinations).

If we can get that to work, we could consider adding the capabilty to associate the comments with specific data values on the row (allowing multiple comments per row tied to Column Fields).

 

[miconian]

Hey JS411, that's great, thanks so much for dedicating time to my little issue.

Ideally, the notes would be in cells, although if they are in comments that's fine too. We aren't using page fields. There are about three levels of row fields, (employee, campaign, line item), and the notes would be made at the line item level. But there are a ton of line items for each campaign, so the user typically collapses the line item field after writing comments, surveys the overall document at the campaign level, and then expands a different campaign to see its line items.

 

[Jerry Sullivan]

Hi again,

Well, this turned out to be harder than I anticipated, but I finally have some code for you to try.

The code allows the user to write notes in the first column of cells to the right of the PivotTable.

As notes are added, revised or deleted, Worksheet_Change event code maintains a data table of the notes on an added sheet.

Each note is indexed by its associated RowField PivotItems... this added sheet can be hidden if you prefer.

Whenever the PivotTable is updated (expanded, collapsed, sorted, refreshed), the notes are cleared and then rewritten to correct positions for the revised PivotTable display.

Because this is fairly complex, I'd encourage you to extensively test this prior to using it for a real world application (and even then make sure to have a back up of your file).

At this point, I'm hopeful this will work for the basic parameters you described.

It assumes you have:
- No more than 1 PivotTable per sheet
- Compact Report layout
- No Page/Report Fields

There's so many options and scenarios for PivotTables, that I expect you'll find some glitches through your testing.

To try it out, paste this code into a Standard Code Module

Option Explicit
 
Public Const sRngName = "PT_Notes"
 
Public Function Check_Setup(ws As Worksheet) As Boolean
    Dim rNotes As Range, i As Long
    Dim PT As PivotTable, ptField As PivotField
    Dim tblNotes As ListObject
    Dim wsSave As Worksheet
 
'---Check if not exactly one PT on Worksheet- exit
    If ws.PivotTables.Count <> 1 Then GoTo StopNotes
    Set PT = ws.PivotTables(1)
 
'---Check if not Compact Report layout- exit
    For Each ptField In PT.RowFields
        If Not ptField.LayoutCompactRow Then GoTo StopNotes
    Next ptField
 
'---Check if Named Range "PT_Notes" doesn't exist- define it
    If Not NameExists(sRngName, ws.Name) Then
        With PT.TableRange1
            Set rNotes = Intersect(PT.DataBodyRange.EntireRow, _
                    .Resize(, 1).Offset(0, .Columns.Count))
        End With
        Set rNotes = rNotes.Resize(rNotes.Rows.Count _
            + PT.ColumnGrand)
        ws.Names.Add Name:=sRngName, RefersTo:=rNotes
        Call Format_NoteRange(rNotes)
    End If
 
'---Check if "|Notes" Worksheet doesn't exist- add it
    If Not SheetExists(ws.Name & "|Notes") Then
        Set wsSave = ActiveSheet
        Sheets.Add
        ActiveSheet.Name = ws.Name & "|Notes"
        wsSave.Activate
    End If
 
'---Check if Notes DataTable doesn't exist- add it
    With Sheets(ws.Name & "|Notes")
        On Error Resume Next
        Set tblNotes = .ListObjects(1)
        If tblNotes Is Nothing Then
            .Cells(1) = "KeyPhrase"
            .Cells(1, 2) = "Note"
            Set tblNotes = .ListObjects.Add(xlSrcRange, _
                .Range("A1:B2"), , xlYes)
        End If
    End With
 
'---Check if any PT fields are not Table Headers - add
    With tblNotes
        For Each ptField In PT.RowFields
            If IsError(Application.Match(ptField.Name, .HeaderRowRange, 0)) Then
                .ListColumns.Add Position:=2
                .HeaderRowRange(1, 2) = ptField.Name
            End If
        Next ptField
    End With
    Check_Setup = True
    Exit Function
 
StopNotes:
    If NameExists(sRngName, ws.Name) Then
        Application.EnableEvents = False
        Call Clear_Notes_Range(ws)
        ws.Names(sRngName).Delete
        Application.EnableEvents = True
        Check_Setup = False
        Exit Function
    End If
End Function
 
Private Function Format_NoteRange(rNotes As Range)
'---Format body
    With rNotes
        .Interior.Color = 16316664
        .Font.Italic = True
        .HorizontalAlignment = xlLeft
        .IndentLevel = 1
        .Borders(xlInsideHorizontal).LineStyle = xlDot
        .Borders(xlBottom).LineStyle = xlDot
    End With
 
'---Format optional header
    With rNotes.Resize(1)(0)
        .Value = "Notes"
        .Interior.Color = 16316664
        .Font.Italic = True
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Borders(xlBottom).LineStyle = xlContinuous
    End With
End Function
 
Private Function Clear_Notes_Range(ws As Worksheet)
'---Clear existing notes range
    On Error Resume Next
    Dim c As Range
    With ws.Range(sRngName)
        With .Offset(-1).Resize(.Rows.Count + 1)
            If Intersect(ws.PivotTables(1).TableRange2, _
                    .Cells) Is Nothing Then
                .ClearContents
                .ClearFormats
            Else 'PT overlaps notes
                For Each c In .Cells
                    c.ClearContents
                    c.ClearFormats
                Next c
                On Error GoTo 0
            End If
        End With
    End With
End Function
 
Public Function Refresh_Notes(PT As PivotTable)
    Dim sField As String, sKey As String, sFormula As String
    Dim ptField As PivotField
    Dim tblNotes As ListObject
    Dim rNotes As Range, c As Range
    Dim rLabels As Range, rLabelsAll As Range
    Dim vFields As Variant, vReturn As Variant
    Dim lPosition As Long, lOffset As Long
    Dim i As Long, lIdx As Long, lCol As Long
 
'---Clear existing notes range
    Call Clear_Notes_Range(ws:=PT.Parent)
'---Redefine and format notes range
    With PT.TableRange1
        Set rNotes = Intersect(PT.DataBodyRange.EntireRow, _
            .Resize(, 1).Offset(0, .Columns.Count))
    End With
    Set rNotes = rNotes.Resize(rNotes.Rows.Count + PT.ColumnGrand)
    PT.Parent.Names(sRngName).RefersTo = rNotes
    Call Format_NoteRange(rNotes)
 
'---Make array of rowfields by position to trace each row in hierarchy
     With PT.RowFields
        ReDim vFields(1 To .Count)
        For lIdx = 1 To .Count
            vFields(PT.RowFields(lIdx).Position) = PT.RowFields(lIdx).Name
        Next lIdx
    End With
 
'---Build formula to use as Match KeyPhrase
    Set tblNotes = Sheets(PT.Parent.Name & "|Notes").ListObjects(1)
    With tblNotes
        On Error Resume Next
        sFormula = "="
        For lIdx = LBound(vFields) To UBound(vFields)
            lCol = Application.Match(vFields(lIdx), .HeaderRowRange, 0)
            sFormula = sFormula & "RC" & lCol & "&""|""&"
        Next lIdx
        sFormula = Left(sFormula, Len(sFormula) - 1)
        Intersect(.DataBodyRange, .ListColumns(1).Range).FormulaR1C1 = sFormula
    End With
 
'---Match KeyPhrases for each visible row of PT
    Application.EnableEvents = False
    With PT.RowRange
        Set rLabelsAll = .Offset(1).Resize(.Rows.Count - 1)
        lOffset = PT.TableRange1.Columns.Count + 1
        For Each c In rLabelsAll
            lIdx = UBound(vFields) + 1
            sKey = ""
            Set rLabels = .Offset(1).Resize(c.Row - .Row)
            For i = rLabels.Rows.Count To 1 Step -1
                sField = rLabels(i).PivotField.Name
                lPosition = Application.Match(sField, vFields, 0)
                Do While lIdx > lPosition + 1
                    sKey = "|" & sKey
                    lIdx = lIdx - 1
                Loop
                If lPosition < lIdx Then
                    sKey = rLabels(i).PivotItem.Name & "|" & sKey
                    lIdx = lPosition
                    If lIdx = 1 Then Exit For
                End If
            Next i
            vReturn = Evaluate("=INDEX(" & tblNotes.Name & "[Note],MATCH(""" & _
                sKey & """," & tblNotes.Name & "[KeyPhrase],0))")
            If (Not IsError(vReturn)) Then c(1, lOffset) = CStr(vReturn)
        Next c
    End With
    Application.EnableEvents = True
End Function
 
Public Function Update_Note_Database(PT As PivotTable, rNote As Range)
    Dim rLabels As Range
    Dim sField As String, sItem As String
    Dim vFields As Variant, tblNotes As ListObject
    Dim lPosition As Long, lIdx As Long
    Dim iArray As Variant, i As Integer
 
'---Make array of rowfields by position to trace each row in hierarchy
     With PT.RowFields
        ReDim vFields(1 To .Count)
        For lIdx = 1 To .Count
            vFields(PT.RowFields(lIdx).Position) = PT.RowFields(lIdx).Name
        Next lIdx
    End With
 
'---Make new record of note at top of database table
    lIdx = lIdx + 1
    Set tblNotes = Sheets(PT.Parent.Name & "|Notes").ListObjects(1)
    tblNotes.ListRows.Add (1)
    tblNotes.ListColumns("Note").Range(2) = rNote.Value
    With PT.RowRange
        Set rLabels = .Offset(1).Resize(rNote.Row - .Row)
        For i = rLabels.Rows.Count To 1 Step -1
            sField = rLabels(i).PivotField.Name
            lPosition = Application.Match(sField, vFields, 0)
            If lPosition < lIdx Then
                sItem = rLabels(i).PivotItem.Name
                tblNotes.ListColumns(sField).Range(2) = sItem
                lIdx = lPosition
                If lIdx = 1 Then Exit For
            End If
        Next i
    End With
 
'---Remove any previous notes with matching rowfield values
    With tblNotes.Range
        ReDim iArray(0 To .Columns.Count - 3)
        For i = 0 To UBound(iArray)
            iArray(i) = i + 2
        Next i
        .RemoveDuplicates Columns:=(iArray), Header:=xlYes
        If rNote = vbNullString Then tblNotes.ListRows(1).Delete
    End With
End Function
 
Private Function NameExists(sRngName As String, _
        sSheetName As String) As Boolean
    Dim rTest As Range
    On Error Resume Next
    Set rTest = Sheets(sSheetName).Range(sRngName)
    NameExists = Not rTest Is Nothing
End Function
 
Private Function SheetExists(sSheetName As String) As Boolean
    Dim sTest As String
    On Error Resume Next
    sTest = Worksheets(sSheetName).Name
    SheetExists = LCase(sTest) = LCase(sSheetName)
End Function

Then paste this code into the Sheet Code Module of the Worksheet that has the PivotTable to be annotated.

Private Sub Worksheet_Change(ByVal Target As Range)
'----When changes are made in the named range displaying
'--    PivotTable Notes, the Note database table
'--    will be updated with each New or Revised note.
 
    Dim rNotesChanged As Range, c As Range
 
    Application.ScreenUpdating = False
    If Check_Setup(Me) = False Then GoTo CleanUp
    Set rNotesChanged = Intersect(Target, _
        Range(sRngName))
    If rNotesChanged Is Nothing Then Exit Sub
    For Each c In rNotesChanged
        Call Update_Note_Database( _
            PT:=Me.PivotTables(1), _
            rNote:=c)
    Next c
CleanUp:
    Set rNotesChanged = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'----Refreshes display of PivotTable Notes from the Note database
'--    when the PivotTable is updated (refreshed, sorted, filtered, etc)
    If Check_Setup(Me) = False Then Exit Sub
 
    Application.ScreenUpdating = False
    Application.EnableEvents = False
 
    Call Refresh_Notes(PT:=Target)
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

You can use the system on more than one worksheet in the same workbook.
Each worksheet can only have one PivotTable, and the Sheet Code needs to be pasted into each worksheet.

 

[miconian]

Wow, that appears to... work perfectly. I will play around with it, and probably deploy it in a work environment in a few weeks. Thanks so much for spending the time to do this. I'm guessing this thread will be oft searched-out in the future.

 

[Ganga]

Hi

Still having difficulty in following the code.... can anyone help ... I need to retain a set of first pass commentary and then on the second refresh retain the first pass commentary to view alongside with the final numbers

Many thanks
Ganga

 

[Jerry Sullivan]

Hi Ganga,

What have you tried so far, and what was the result?

 

[Ganga]

Hi Jerry

I tried copy and pasting the code above, created a tab called PT Notes and tried running the code. It gives an error at the 1st step

"

Public Const sRngName = "PT_Notes"

​

---

I am quite new to these so I am not sure what I am doing wrong ?

Thank you for taking time to respond

Ganga


​