wildturkey
Board Regular
- Joined
- Feb 21, 2006
- Messages
- 189
- Office Version
- 365
- Platform
- Windows
Somehow I've managed to get this to work perfectly (from an old Jerry Sullivan post (Thank you) , and my pivot updates to changes made to a cell - it works with everything apart from dates (error is that 'none of filter items found' - there are, I've checked) - any ideas please?
I'm currently using the following in the pivot worksheet...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sField As String, sDV_Address As String
Dim ptTables As PivotTables
sField = "date" 'Field Name
sDV_Address = "$g$1" 'Cell with DV dropdown to select filter item.
With ActiveSheet
If Intersect(Target, Range(sDV_Address)) Is Nothing Or _
Target.Cells.Count > 1 Then Exit Sub
On Error GoTo CleanUp
Application.EnableEvents = False
Call Filter_PivotField( _
pvtField:=.PivotTables("PivotTable2").PivotFields(sField), _
vItems:=Target.Value)
' Call Filter_PivotField( _
' pvtField:=.PivotTables("PivotTable2").PivotFields(sField), _
' vItems:=Target.Value)
End With
CleanUp:
Application.EnableEvents = True
End Sub
And the following in the worksheet module...
Public Function Filter_PivotField(pvtField As PivotField, _
vItems As Variant)
'---Filters the PivotField to make stored vItems Visible
Dim sItem As String, bTemp As Boolean, i As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Not (IsArray(vItems)) Then
vItems = Array(vItems)
End If
With pvtField
.Parent.ManualUpdate = True
If .Orientation = xlPageField Then .EnableMultiplePageItems = True
If vItems(0) = "(All)" Then
For i = 1 To .PivotItems.Count
If Not .PivotItems(i).Visible Then _
.PivotItems(i).Visible = True
Next i
Else
For i = LBound(vItems) To UBound(vItems)
bTemp = Not (IsError(.PivotItems(vItems(i)).Visible))
If bTemp Then
sItem = .PivotItems(vItems(i))
Exit For
End If
Next i
If sItem = "" Then
MsgBox "None of filter list items found."
GoTo CleanUp
End If
.PivotItems(sItem).Visible = True
For i = 1 To .PivotItems.Count
If IsError(Application.Match(.PivotItems(i), _
vItems, 0)) = .PivotItems(i).Visible Then
.PivotItems(i).Visible = Not (.PivotItems(i).Visible)
End If
Next i
End If
End With
CleanUp:
pvtField.Parent.ManualUpdate = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function
I'm currently using the following in the pivot worksheet...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sField As String, sDV_Address As String
Dim ptTables As PivotTables
sField = "date" 'Field Name
sDV_Address = "$g$1" 'Cell with DV dropdown to select filter item.
With ActiveSheet
If Intersect(Target, Range(sDV_Address)) Is Nothing Or _
Target.Cells.Count > 1 Then Exit Sub
On Error GoTo CleanUp
Application.EnableEvents = False
Call Filter_PivotField( _
pvtField:=.PivotTables("PivotTable2").PivotFields(sField), _
vItems:=Target.Value)
' Call Filter_PivotField( _
' pvtField:=.PivotTables("PivotTable2").PivotFields(sField), _
' vItems:=Target.Value)
End With
CleanUp:
Application.EnableEvents = True
End Sub
And the following in the worksheet module...
Public Function Filter_PivotField(pvtField As PivotField, _
vItems As Variant)
'---Filters the PivotField to make stored vItems Visible
Dim sItem As String, bTemp As Boolean, i As Long
On Error Resume Next
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Not (IsArray(vItems)) Then
vItems = Array(vItems)
End If
With pvtField
.Parent.ManualUpdate = True
If .Orientation = xlPageField Then .EnableMultiplePageItems = True
If vItems(0) = "(All)" Then
For i = 1 To .PivotItems.Count
If Not .PivotItems(i).Visible Then _
.PivotItems(i).Visible = True
Next i
Else
For i = LBound(vItems) To UBound(vItems)
bTemp = Not (IsError(.PivotItems(vItems(i)).Visible))
If bTemp Then
sItem = .PivotItems(vItems(i))
Exit For
End If
Next i
If sItem = "" Then
MsgBox "None of filter list items found."
GoTo CleanUp
End If
.PivotItems(sItem).Visible = True
For i = 1 To .PivotItems.Count
If IsError(Application.Match(.PivotItems(i), _
vItems, 0)) = .PivotItems(i).Visible Then
.PivotItems(i).Visible = Not (.PivotItems(i).Visible)
End If
Next i
End If
End With
CleanUp:
pvtField.Parent.ManualUpdate = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function