VBA code to restrict all Pivot Table fields except for one

Question

Hello,

I am working with a data model pivot table that contains dozens of fields. I would like to restrict the users of the pivot table from adding or removing all fields except for one.

The field called "Title Name" should be fully functional. The user can add or remove this filed to the pivot table as needed.

All other fields should be restricted. The user can filter theses  fields but not remove them from the pivot table or add any new fields into the pivot table. 

Is this possible? I have been using this section of code. It enables the user to filter the existing fields in the table but not add or remove the "Title Name' field as needed.

Sub RestrictPivotTable_DM()

Dim pf As PivotField

Dim wb As Workbook

Dim pt As PivotTable

On Error Resume Next

Set wb = ActiveWorkbook

Set pt = ActiveCell.PivotTable

wb.ShowPivotTableFieldList = False

With pt

  .EnableWizard = False

  .EnableDrilldown = False

  .EnableFieldDialog = False

  .PivotCache.EnableRefresh = False

  For Each pf In .PivotFields

    If pf.Name <> "Data" And _

          pf.Name <> "Values" Then

      If .IsCalculated = False Then

        With pf

          .DragToPage = False

          .DragToRow = False

          .DragToColumn = False

          .DragToHide = False

        End With

      End If

    End If

  Next pf

End With

End Sub

Any help you can provide would be greatly appreciated.

Thank you.

Answer 1

Thanks Sheeloo!

I appreciate your help. This gets me pretty close to what I want it to do. I have to tweak it a little bit but I think I can take it from here.

Thanks again

Answer 2

You already have the basic code... I made some modifications to your code...

It will allow addition/removal of the field called 'Title Name'

Try this

Sub RestrictPivotTable_DM()

Dim pf As PivotField

Dim wb As Workbook

Dim pt As PivotTable

On Error Resume Next

Set wb = ActiveWorkbook

Set pt = ActiveCell.PivotTable

wb.ShowPivotTableFieldList = False

With pt

  .EnableWizard = True

  .EnableDrilldown = False

  .EnableFieldDialog = False

  .PivotCache.EnableRefresh = True

  For Each pf In .PivotFields

    If pf.Name <> "Title Name" Then

      If .IsCalculated = False Then

        With pf

          .DragToPage = False

          .DragToRow = False

          .DragToColumn = False

          .DragToHide = False

        End With

      End If

    End If

  Next pf

End With

End Sub