Pivot Table Labels in dropdowns

Sub Delete_Unused_PivotFields() 
    ' This code originally is taken from Experts Exchange question:
    ' http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_21318662.html
    ' Author: Dennis Wallentin (a.k.a. XL-Dennis)
    
    ' This sub will:
    ' 1) Loop through all worksheets in the ActiveWorkbook
    ' 2) Loop through each PivotTable on each worksheet
    ' 3) Loop through each PivotField in the table
    ' 4) Try to delete each PivotItem for each field
    
    ' Excel will not allow a deletion of a PivotItem that has at least one detail record
    ' in the source.  The On Error Resume Next error handler enables to sub to carry on despite
    ' the error that would occur
    
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim ptTable As PivotTable
    Dim ptField As PivotField
    Dim ptItem As PivotItem
    Dim i As Long
    
    Set wbBook = ActiveWorkbook
    
    On Error Resume Next
    
    For i = 1 To 2
        For Each wsSheet In wbBook.Worksheets
         For Each ptTable In wsSheet.PivotTables
            For Each ptField In ptTable.PivotFields
               For Each ptItem In ptField.PivotItems
                  ptItem.Delete
               Next ptItem
            Next ptField
            ptTable.RefreshTable
         Next ptTable
       Next wsSheet
    Next i
    
    On Error GoTo 0 
End Sub

Select allOpen in new window