Pivot Table: Selecting Drop Downs with Criteria

Not that I am aware of... this is an interesting question to me at least.

I came up with the following...

First create a custom right click option to add to the PT right click menu

To be added to ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Run "DeleteRC"
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Run "DeleteRC"
Run "AddRC"
End Sub

To be added to a standard Module

Private Sub AddRC()
Dim ctrl As CommandBarControl
Set ctrl = Application.CommandBars("PivotTable Context Menu").Controls.Add(Type:=1, Before:=1)
With ctrl
    .Caption = "Apply PT Filter"
    .OnAction = "PTFilter"
End With
Set ctrl = Nothing
End Sub

Private Sub DeleteRC()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("PivotTable Context Menu").Controls
   If ctrl.Caption = "Apply PT Filter" Then ctrl.Delete
Next
End Sub

Second insert the code to be run when the above right click option is invoked, again to be stored in a standard module:

Private Sub PTFilter()
Dim PT As PivotTable, PF As PivotField, PI As PivotItem
Dim PFDT As XlPivotFieldDataType
Dim vStart As Variant, vEnd As Variant, vMin As Variant, vMax As Variant
Dim boolFound As Boolean
On Error GoTo Handler
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
Set PT = ActiveCell.PivotTable
Set PF = ActiveCell.PivotField
PT.ManualUpdate = True
PFDT = PF.DataType
vStart = Application.InputBox("Start Value", Type:=IIf(PFDT = xlText, 2, 1))
vEnd = Application.InputBox("End Value", Type:=IIf(PFDT = xlText, 2, 1))
If CStr(vStart) = "False" Or CStr(vEnd) = "False" Then
    MsgBox "Invalid Parameters - Routine Terminated", vbCritical, "Error"
Else
    vMin = IIf(vStart <= vEnd, vStart, vEnd)
    vMax = IIf(vStart <= vEnd, vEnd, vStart)
    With PT
        On Error Resume Next
        PF.PivotItems(CStr(vMin)).Visible = True
        If Err.Number Then PF.PivotItems(CStr(vMax)).Visible = True
        If Err.Number Then
            On Error GoTo Handler
            'ensure one valid item is visible before iterating and hiding remainder
            'XL2007 can use ClearAllFilters but function missing in earlier versions
            '(no guarantee min/max exist as items in Pivot Field hence loop)
            For Each PI In PF.PivotItems
                Select Case PFDT
                    Case xlText
                        boolFound = CStr(PI.Value) >= CStr(vMin) And CStr(PI.Value) <= CStr(vMax)
                    Case Else
                        boolFound = CDbl(PI.Value) >= CDbl(vMin) And CDbl(PI.Value) <= CDbl(vMax)
                End Select
                If boolFound Then
                    PI.Visible = True
                    Exit For
                End If
            Next PI
        End If
        On Error GoTo Handler
        'given 1 item is visible (if valid) one can now iterate remaining items
        For Each PI In PF.PivotItems
            Select Case PFDT
                Case xlText
                    PI.Visible = CStr(PI.Value) >= CStr(vMin) And CStr(PI.Value) <= CStr(vMax)
                Case Else
                    PI.Visible = CDbl(PI.Value) >= CDbl(vMin) And CDbl(PI.Value) <= CDbl(vMax)
            End Select
        Next PI
    End With
End If
ExitPoint:
PT.ManualUpdate = False
Set PF = Nothing
Set PT = Nothing
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
Exit Sub

Handler:
Select Case Err.Number
    Case 1004
        MsgBox "No Items Meet Criteria " & vbLf & vbLf & _
                "One Item Must Remain Visible at all Times", vbCritical, "Action Incomplete"
    Case Else
        MsgBox "Error Has Occurred" & vbLf & vbLf & _
                "Error Number: " & Err.Number & vbLf & vbLf & _
                "Error Desc.: " & Err.Description, _
                vbCritical, _
                "Fatal Error"
End Select
Resume ExitPoint

End Sub

What should now happen is that if you right click on your Pivot and opt to Apply Filter you should be presented with two consecutive dialogs for min & max parameters - the code should do the rest...
obviously to clear the filter use the standard functionality (ie All)

The above should work for both Row & Column fields.

I'm sure there's better code out there but this was what I came up with ...

On an aside if you do lots of PT work you might want to check out Debra Dalgleish's PT add-in

http://www.contextures.com/xlPivotAddIn02.html

From what I could tell at first glance the above was not covered hence the grotesque code above.

(caveat is I've not tested in any great detail - ie where field may be grouped etc etc...)

EDIT:
I attached the small working file I used to test the above - as I say don't shoot me if it's not 100% watertight !
Code can be tidied up but it's more a case of proof of concept at this stage I think ?