Setting PivotItems Visibility with hyperlinked UDF doesn't work

[jim-nf]

Hello!

I am currently trying to filter a PivotTable using a hyperlinked UDF.

I have put together a demo sheet which can be downloaded below. Its a combination of a technique by someone at MS that sets a Pivot Filter by a cell value (D2) and a hyperlink idea from an article at Chandoo.org that I have modified to change the value in D2. The sub highlightSeries handles the setting of the cell (D2) value by the 3 hyperlinks, the UDF then calls the update:

Call ThisWorkbook.UpdatePivotFieldFromRange("RegionFilterRange", "PivotTable1", "Region")

This should then update the Pivot Table as the Workbook_SheetChange event is not trigged by my hyperlinked UDF.

From many hours of looking at the issue the problem seems to be that SelectPivotItem() which is called from UpdatePivotFieldfromRange can't update the visibility of PivotItems when called in this way.

Is this an issue with the UDF? Or is there another way to set the visibility of the PivotItems?

Code & link to example file follows:

Option Explicit

Const RegionRangeName As String = "RegionFilterRange"
Const PivotTableName As String = "PivotTable1"
Const PivotFieldName As String = "Region"


Public Sub UpdatePivotFieldFromRange(RangeName As String, FieldName As String, _
PivotTableName As String)

    Dim rng As Range
    Set rng = Application.Range(RangeName)
    
    Dim pt As PivotTable
    Dim Sheet As Worksheet
    For Each Sheet In Application.ActiveWorkbook.Worksheets
        On Error Resume Next
        Set pt = Sheet.PivotTables(PivotTableName)
    Next
    If pt Is Nothing Then GoTo Ex
    
    On Error GoTo Ex
    
    pt.ManualUpdate = True
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    Dim Field As PivotField
    Set Field = pt.PivotFields(FieldName)
    Field.ClearAllFilters
    Field.EnableItemSelection = False
    SelectPivotItem Field, rng.Text
    pt.RefreshTable
    
Ex:
    pt.PivotFields(FieldName).AutoSort xlAscending, FieldName
    pt.ManualUpdate = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    
End Sub

Public Sub SelectPivotItem(Field As PivotField, ItemName As String)
    Dim Item As PivotItem
    For Each Item In Field.PivotItems
        Item.Visible = (Item.Caption = ItemName)
    Next
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Application.Range(RegionRangeName)) _
        Is Nothing Then
            UpdatePivotFieldFromRange _
            RegionRangeName, PivotFieldName, PivotTableName
    End If
End Sub

Public Function highlightSeries(seriesName As Range)
    Range("RegionFilterRange") = seriesName.Value
    Call ThisWorkbook.UpdatePivotFieldFromRange("RegionFilterRange", "PivotTable1", "Region")

End Function

Link to example file

I've also posted a similar query here (just for transparency):

http://www.excelforum.com/excel-programming/792284-filter-pivot-table-with-hover.html

Any help or insight would be great. Thanks.