problem:filter pivotable with 2 text cells

[JayJay6]

Hi people,

I hope Yuo can help me with a irritating problem:

I am trying to make 2 text cells ("RegionFilterRange1", "RegionFilterRange2") work as free text filters on my "pivotable2".

But I can't seem to get it work. It works fine when I have one filter ("RegionFilterRange1"), but if I try to add the second one, I get the error message: "Compile error: ByRef argument type mismatch".

any ideas ?

(I attach a worksheet example)

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

Dim Sheet As Worksheet
Dim pt As PivotTable
Dim rng1, rng2, rng3 As Range
Dim vecItems As Variant

Set rng1 = Application.Range("RegionFilterRange")
Set rng2 = Application.Range("RegionFilterRange2")

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, Field2 As PivotField

Set Field = pt.PivotFields("Region")
Set Field2 = pt.PivotFields("Name")

Field.Range(Field, Field2).ClearAllFilters
Field.EnableItemSelection = False

If Range(rng1, rng2).Text = "(All)" Then
Call ResetAllItems(pt, FieldName)
Else

vecItems1 = GetItems(Worksheets("Sheet1").Range("A2:A20"), rng1.Text)
vecItems2 = GetItems(Worksheets("Sheet1").Range("B2:B20"), rng2.Text)
Call SelectPivotItem(Field, vecItems1)
Call SelectPivotItem(Field2, vecItems2)
End If
pt.RefreshTable
End If


Ex:
pt.ManualUpdate = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub ----------

best regards,
Jakob

[mancubus]

pls use VBA tags to display your code.

is it

Call SelectPivotItem(Field1, vecItems1)
Call SelectPivotItem(Field2, vecItems2)


rather than

Call SelectPivotItem(Field, vecItems1)
Call SelectPivotItem(Field2, vecItems2)



in Public Sub UpdatePivotFieldFromRange

[JayJay6]

Hi Mancubus,
forgive my ignorance, but i am not that familiar with VBA tags? I have corrected the syntax according to your prescription, but I still get the ByRef - error.

br,
Jakob

[mancubus]

my bad. :dunno
Dim Field, Field2 As PivotField

to properly declare variables use below instead (not related with the problem)
Dim Field As PivotField, Field2 As PivotField


for VBA tags, click green VBA button.
[ VBA ] [ /VBA ] tags are added (without spaces). write/copy your code in between.

[JayJay6]

Thanks Mancabus. My error diseappeared, but I still can't get the script working ? any ideas ?

br,
Jakob

[mancubus]

wellcome Jacob.
forget about my previous messages posted as a result of misunderstanding.

i have seen the orginal code here:
http://blogs.msdn.com/b/gabhan_berry/archive/2008/01/31/using-cell-text-to-filter-pivottables.aspx

i am not sure if i got your points...

if you want a macro which filters pt rows based on a cell value that matches a pivot item and that macro is triggered by change in that cell....
and then if you want a second macro which filters pt rows based on a second cell value that matches another pivot item and that second macro is triggered by change in second cell...

perhaps you may play around with the original code.

goes to standard code module:

Public Sub UpdatePivotFieldFromRange( _
RangeName As String, _
FieldName As String, _
PivotTableName As String)
'http://blogs.msdn.com/b/gabhan_berry/archive/2008/01/31/using-cell-text-to-filter-pivottables.aspx

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, pi As PivotItem
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






goes to related sheet's code module:

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("RegionFilterRange", "RegionFilterRange2")) Is Nothing Then Exit Sub
If Len(Trim(Target.Value)) = 0 Then Exit Sub

If Target.Address = Range("RegionFilterRange").Address Then
UpdatePivotFieldFromRange "RegionFilterRange", "Region", "PivotTable2"
ElseIf Target.Address = Range("RegionFilterRange2").Address Then
UpdatePivotFieldFromRange "RegionFilterRange2", "Name", "PivotTable2"
End If
End Sub

[mancubus]

below can be used for making rows of "PivotTable2" visible.


Sub pt_vis_pi()

Dim pf As PivotField
Dim pi As PivotItem

With ActiveSheet.PivotTables("PivotTable2")
For i = 1 To .PivotFields.Count
Set pf = .PivotFields(i)
For Each pi In pf.PivotItems
pi.Visible = True
Next
Next
End With

End Sub

[JayJay6]

Thanks Mancobus,

"playaround with the original code" is what I've been doing, and as of now the only thing that I can't seem to get working is the If-statement below.
The script works fine on one cell as long as I clear out the "vecItems2" and the "Call"-statement for (field2,vecItem2).

Do you by any chance know how to make the If-statement below work ?

If Range("rng1", "rng2").Text = "(All)" Then
Call ResetAllItems(pt, Range("Region", "Name"))

Else

vecItems1 = GetItems(Worksheets("Sheet1").Range("A2:A20"), rng1.Text)
' vecItems2 = GetItems(Worksheets("Sheet1").Range("B2:B20"), rng2.Text)

Call SelectPivotItem(Field, vecItems1)
' Call SelectPivotItem(Field2, vecItems2)

End If

Br,
Jakob

[mancubus]

this is what i come up with so far...
you can adopt to your case, i believe...


Sub PvtTblFilters()
'http://www.vbaexpress.com/forum/showthread.php?t=39036

Dim pvtItem As PivotItem
Dim critRegion As String, critName As String
Dim critFound As Boolean
Const strMsg As String = "Invalid or Blank Filter Criterion. Pls Check!"

critRegion = Range("RegionFilterRange").Value
critName = Range("RegionFilterRange2").Value

With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Region")
'remove filters, if any:
For i = 1 To .PivotItems.Count
If .PivotItems(i).Visible = False Then
.PivotItems(i).Visible = True
End If
Next
'determine if filter criterion exists in PivotItems
critFound = False
For Each pvtItem In .PivotItems
If LCase(pvtItem.Name) = LCase(critRegion) Then
critFound = True
Exit For
End If
Next
'if found apply filter, if not found display a warning message
If critFound Then
For i = 1 To .PivotItems.Count
If .PivotItems(i).Name = critRegion Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
Next
Else
MsgBox strMsg, vbOKOnly, "W A R N I N G"
End If
End With
With .PivotFields("Name")
'remove filters, if any:
For i = 1 To .PivotItems.Count
If .PivotItems(i).Visible = False Then
.PivotItems(i).Visible = True
End If
Next
'determine if filter criterion exists in PivotItems
critFound = False
For Each pvtItem In .PivotItems
If LCase(pvtItem.Name) = LCase(critName) Then
critFound = True
Exit For
End If
Next
'if found apply filter, if not found display a warning message
If critFound Then
For i = 1 To .PivotItems.Count
If .PivotItems(i).Name = critName Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
Next
Else
MsgBox strMsg, vbOKOnly, "W A R N I N G"
End If
End With
End With
End Sub

[mancubus]

just added the lines for crit = "All"


Sub PvtTblFilters()
'http://www.vbaexpress.com/forum/showthread.php?t=39036

Dim pvtItem As PivotItem
Dim critRegion As String, critName As String
Dim critFound As Boolean
Const strMsg As String = "Invalid or Blank Filter Criterion. Pls Check!"

Application.ScreenUpdating = False

critRegion = Range("RegionFilterRange").Value
critName = Range("RegionFilterRange2").Value

With ActiveSheet.PivotTables("PivotTable2")
With .PivotFields("Region")
'remove filter, if any:
For i = 1 To .PivotItems.Count
If .PivotItems(i).Visible = False Then
.PivotItems(i).Visible = True
End If
Next
'determine if filter criterion exists in PivotItems
critFound = False
For Each pvtItem In .PivotItems
If LCase(pvtItem.Name) = LCase(critRegion) Then
critFound = True
Exit For
End If
Next
'if found apply filter, if not found display a warning message
If critFound Then
For i = 1 To .PivotItems.Count
If .PivotItems(i).Name = critRegion Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
Next
Else
If critRegion = "All" Then
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
Next
Else
MsgBox strMsg, vbOKOnly, "W A R N I N G"
End If
End If
End With

With .PivotFields("Name")
'remove filter, if any:
For i = 1 To .PivotItems.Count
If .PivotItems(i).Visible = False Then
.PivotItems(i).Visible = True
End If
Next
'determine if filter criterion exists in PivotItems
critFound = False
For Each pvtItem In .PivotItems
If LCase(pvtItem.Name) = LCase(critName) Then
critFound = True
Exit For
End If
Next
'if found apply filter, if not found display a warning message
If critFound Then
For i = 1 To .PivotItems.Count
If .PivotItems(i).Name = critName Then
.PivotItems(i).Visible = True
Else
.PivotItems(i).Visible = False
End If
Next
Else
If critName = "All" Then
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
Next
Else
MsgBox strMsg, vbOKOnly, "W A R N I N G"
End If
End If
End With
End With

Application.ScreenUpdating = True

End Sub