Changing a pivot table with a cell value

Hello all,

What I am trying to do is select a value in a named cell range called “DataSelection” to change the data field called” Name” within a Pivot Table called” PivotTable1”. I have been trying to get this code to work but I keep getting a run-time error ‘1004’ Method ‘Intersect’ of object ‘_Global’ failed. Whenever I try to select another data validation list I have on the worksheet, that has no relationship to PivotTable1.
Here is the code:

Option Explicit

Const RegionRangeName As String = "DataSelection"
Const PivotTableName As String = "PivotTable1"
Const PivotFieldName As String = "Name"

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.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

Thanks