VBA Protect pivot table

[nizc]

So I have an issue that I have been beating my head against the wall for several weeks. I have three pivot tables on one sheet. I want to protect the pivot table in a way that no one can mess with the fields, but still can expand/collapse and refresh. I have attached screenshots of my issue.

This is my data before.

Anyone can click or double click and edit the data.

This is the code that I have been using. There are 7 identical sheets that all run off this same code, the Strings shtName are passed from the sheet to the ThisWorkbook sheet.

Sub Activate_Worksheet(ByVal shtName As String, ByVal shtProtCell As String)

If shtName = "Splash" Then 'Catches errors caused by the splash function
    Exit Sub
End If

Dim pt1 As PivotTable
Dim pf1 As PivotField
Dim pi1 As PivotItem

Set pt1 = Sheets(shtName).PivotTables(shtName & "Table1") 'PivotTables("ChicagoTable1")

If ActiveWorkbook.Worksheets("FunctionSheet").Range(shtProtCell) = "1" Then 'I have a cell that enables protection of the pivot table
    pt1.EnableDrilldown = False
    pt1.EnableWizard = False
    pt1.EnableFieldList = False
    pt1.EnableFieldDialog = False
    pt1.EnableDataValueEditing = False
End If

If ActiveWorkbook.Worksheets("FunctionSheet").Range(shtProtCell) = "0" Then
    pt1.EnableDrilldown = True
    pt1.EnableWizard = True
    pt1.EnableFieldList = True
    pt1.EnableFieldDialog = True
    pt1.EnableDataValueEditing = True
End If

pt1.PivotFields("Region").CurrentPage = shtName 'Sets the pivotfilter 

    For Each pf1 In pt1.PageFields
        pf1.EnableItemSelection = False
        pf1.DragToPage = False
        pf1.DragToRow = False
        pf1.DragToColumn = False
        pf1.DragToData = False
        pf1.DragToHide = False

        If pf1 = "Region" And ActiveWorkbook.Worksheets("FunctionSheet").Range(shtProtCell) = "1" Then 'This locks the pivot filter cell
            pf1.EnableItemSelection = False
        Else
            pf1.EnableItemSelection = True
        End If
    Next pf1

...More useless code....

End Sub

I want to restrict the ability of users to edit the data in the pivot table and mess it up. I have tried using the protect sheet option, but I don't like it. It doesn't have the versatility that I require.

 

[Jerry Sullivan]

Hi and Welcome to the Board,

Which version of Excel are you using?

With the code that you are currently using, are you just needing to add protection to keep the users from changing the Captions for PivotItems in RowFields and ColumnFields, or are there are other elements that need additional protection?

 

[nizc]

I am using excel 2011 for mac, but I need it to be compatible with earlier versions (probably 2003 at the earliest). That is exactly what I am looking for. I may just use sheet protection.

 

[Jerry Sullivan]

Here's an approach that works on Excel 2010. Hopefully it will work on your Mac as well.

Paste the code into the ThisWorkbook module

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo CleanUp

    
    If Target.PivotCell Is Nothing Then Exit Sub

    
    Select Case Target.PivotCell.PivotCellType
        Case xlPivotCellPivotItem, xlPivotCellSubtotal, xlPivotCellGrandTotal
            Application.EnableEvents = False
            Application.Undo
            '--Optional message
            MsgBox "PivotItem captions should not be modified."
        Case Else
            '--No action
    End Select

    
CleanUp:
    Application.EnableEvents = True
End Sub