i have tried below script but it doesn't activate the filters on Pivottable2.
Does anyone have an idea?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
On Error GoTo ErrHandler
If Not Intersect(Target, Range( _
"c6:g8")) Is Nothing Then
Application.EnableEvents = False
Range("A13").Value = Range("B" & ActiveCell.Row)
Range("B13").Value = Range("A" & ActiveCell.Row)
Range("A14").Value = Cells(5, ActiveCell.column)
Range("B14").Value = Cells(4, ActiveCell.column)
End If
Dim Checklist As Variant
Checklist = Array("Sep", "Oct", "Nov", "Dec", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "2016", "2017", "2018")
If Checklist.exists(Range("B13").Value) Then
ActiveSheet.PivotTables("PivotTable2").PivotFields("order year").CurrentPage = Range("B13").Value
End If
If Checklist.exists(Range("A13").Value) Then
ActiveSheet.PivotTables("PivotTable2").PivotFields("order Month").CurrentPage = Range("A13").Value
End If
If Checklist.exists(Range("A14").Value) Then
ActiveSheet.PivotTables("PivotTable2").PivotFields("delivery year").CurrentPage = Range("B14").Value
End If
If Checklist.exists(Range("B14").Value) Then
ActiveSheet.PivotTables("PivotTable2").PivotFields("delivery month").CurrentPage = Range("A14").Value
End If
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Bookmarks