VBA script doesn't run

[Bob Phillips]

This should do it (note, I have added an option to reset the filter by inputting '(All)'). You have to add the wildcard, like *K or D*.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Application.Range("RegionFilterRange")) Is Nothing Then
        UpdatePivotFieldFromRange _
        "RegionFilterRange", "Region", "PivotTable2"
    End If
End Sub

Public Sub UpdatePivotFieldFromRange( _
    ByVal RangeName As String, _
    ByVal FieldName As String, _
    ByVal PivotTableName As String)
    Dim Sheet As Worksheet
    Dim pt As PivotTable
    Dim rng As Range
    Dim vecItems As Variant
    Set rng = Application.Range("RegionFilterRange")
    For Each Sheet In Application.ActiveWorkbook.Worksheets
        On Error Resume Next
        Set pt = Sheet.PivotTables("PivotTable2")
    Next
    On Error GoTo Ex
    If Not pt Is Nothing Then
        pt.ManualUpdate = True
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim Field As PivotField
        Set Field = pt.PivotFields("Region")
        Field.ClearAllFilters
        Field.EnableItemSelection = False
        If rng.Text = "(All)" Then
            Call ResetAllItems(pt, "Region")
        Else
            vecItems = GetItems(Worksheets("Sheet1").Range("A2:A20"), rng.Text)
            Call SelectPivotItem(Field, vecItems)
        End If
        pt.RefreshTable
    End If
    Ex:
    pt.ManualUpdate = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Private Function GetItems( ByVal LookupList As Range, ByVal LookupValue As Variant) As Variant
    Dim vecItems As Variant
    Dim cell As Range
    Dim cntItems As Long
    ReDim vecItems(1 To Application.CountA(LookupList))
    For Each cell In LookupList.Cells
        If cell.Text Like LookupValue Then
            cntItems = cntItems + 1
            vecItems(cntItems) = cell.Text
        End If
    Next cell
    ReDim Preserve vecItems(1 To cntItems)
    GetItems = vecItems
End Function

Private Function ResetAllItems( _
    ByRef pt As PivotTable, _
    ByVal ItemName As String) As Boolean
    Dim Item As PivotItem
    With pt
        For Each Item In .PivotFields(ItemName).PivotItems
            Item.Visible = True
        Next Item
    End With
End Function

Private Sub SelectPivotItem(Field As PivotField, ItemNames As Variant)
    Dim Item As PivotItem
    For Each Item In Field.PivotItems
        Item.Visible = Not (IsError(Application.Match(Item.Caption, ItemNames, 0)))
    Next
End Sub