• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

vba code to filter multiple pivot tables based on a cell value

fri3nd5

New Member
Hi guys! Again i need your experience :)

I have one sheet ("DATA") where i create 4 single column tables ("TYEAR" - [Year], "TWEEKNO" - [Week #], "MAIN CONTRACTOR" - [Main Contractor]).

I have another 2 sheets, each having a table. Tables are different but both have column "Year", "Week #", "Main Contractor"

I created relationship between tables based on this 3 columns.
On another sheet i insert 2 pivot table which have both as filter these columns. When i manually filter the 1st pivot table the 2nd changes automatically. (which is good ... that's what i wanted)

The problem is that i want to filter the 1st pivot table (and of course the 2nd to change as well) based on a cell value.
I have used the code below but is not working. Which is the problem?

Thank you very much!

'PIVOT TABLE
' Variable Declaration
Dim pt As PivotTable
Dim ptitemmc As PivotItem
Dim ptitemy As PivotItem
Dim ptitemwk As PivotItem
Dim FieldMC As PivotField
Dim FieldYEAR As PivotField
Dim FieldWEEK As PivotField
Dim NewMC As String
Dim NewYEAR As String
Dim NewWEEKa As String
' Assign the starting variable values
Set pt = Worksheets("PVT STATS").PivotTables("PivotTable1")
pt.RefreshTable
Set FieldYEAR = pt.PivotFields("YEAR")
Set FieldWEEK = pt.PivotFields("WEEK #")
Set FieldMC = pt.PivotFields("MAIN CONTRACTOR")

NewYEAR = Worksheet4.Range("A6").Value
NewWEEK = Worksheet4.Range("C6").Value
NewMC = Worksheet4.Range("D6").Value

' Delete ghost PivotItems
For Each ptitemy In FieldYEAR.PivotItems
On Error Resume Next
ptitemy.Delete
On Error GoTo 0
Next ptitemy
For Each ptitemwk In FieldWEEK.PivotItems
On Error Resume Next
ptitemwk.Delete
On Error GoTo 0
Next ptitemwk

For Each ptitemmc In FieldMC.PivotItems
On Error Resume Next
ptitemmc.Delete
On Error GoTo 0
Next ptitemmc
' Test for valid filter value
On Error GoTo InvalidFilter1
FieldYEAR.PivotItems(NewYEAR).Visible = True
On Error GoTo 0

On Error GoTo InvalidFilter1
FieldWEEK.PivotItems(NewWEEK).Visible = True
On Error GoTo 0
On Error GoTo InvalidFilter1
FieldMC.PivotItems(NewMC).Visible = True
On Error GoTo 0
' Loop though PivotItems
For Each ptitemy In FieldYEAR.PivotItems
If ptitemy = NewYEAR Then
ptitemy.Visible = True
Else
ptitemy.Visible = False
End If
Next ptitemy
For Each ptitemwk In FieldWEEK.PivotItems
If ptitemwk = NewWEEK Then
ptitemwk.Visible = True
Else
ptitemwk.Visible = False
End If
Next ptitemwk
For Each ptitemmc In FieldMC.PivotItems
If ptitemmc = NewMC Then
ptitemmc.Visible = True
Else
ptitemmc.Visible = False
End If
Next ptitemmc

Sheet4.Cells(6, 12) = Sheet8.Cells(12, 1).Value
Sheet4.Cells(6, 13) = Sheet8.Cells(12, 2).Value
Sheet4.Cells(6, 11) = Sheet8.Cells(12, 3).Value
Sheet4.Cells(6, 10) = Sheet8.Cells(12, 4).Value
' Stop the code so it doesn't do the InvalidFilter bit

' This runs if there was an error in the test
InvalidFilter1:
Sheet4.Cells(6, 10) = 0
Sheet4.Cells(6, 11) = 0
Sheet4.Cells(6, 13) = 0
Sheet4.Cells(6, 12) = 0


__________________________________________________________________

POST MOVED BY MOD
 
Last edited by a moderator:
Upload a sample workbook mirroring your set up to get a faster help. And please use, CODE tag.
 
Hi Chihiro!
Thanks for willing to help. Unfortunately i don't know how to use CODE tag and the document is the same like last time when you wanted to help me (very big even if i save it as xlsb.
you can download the document from here: https://we.tl/2gxbyY0d1t

All the best!
 
You see the menu when you post. Click on this upload_2017-3-27_9-27-55.png button and you can nest code inside code tag.

Code:
'PIVOT TABLE
' Variable Declaration
Dim pt As PivotTable
Dim ptitemmc As PivotItem
Dim ptitemy As PivotItem
Dim ptitemwk As PivotItem
Dim FieldMC As PivotField
Dim FieldYEAR As PivotField
Dim FieldWEEK As PivotField
Dim NewMC As String
Dim NewYEAR As String
Dim NewWEEKa As String
' Assign the starting variable values
Set pt = Worksheets("PVT STATS").PivotTables("PivotTable1")
pt.RefreshTable
Set FieldYEAR = pt.PivotFields("YEAR")
Set FieldWEEK = pt.PivotFields("WEEK #")
Set FieldMC = pt.PivotFields("MAIN CONTRACTOR")

NewYEAR = Worksheet4.Range("A6").Value
NewWEEK = Worksheet4.Range("C6").Value
NewMC = Worksheet4.Range("D6").Value

' Delete ghost PivotItems
For Each ptitemy In FieldYEAR.PivotItems
On Error Resume Next
ptitemy.Delete
On Error GoTo 0
Next ptitemy
For Each ptitemwk In FieldWEEK.PivotItems
On Error Resume Next
ptitemwk.Delete
On Error GoTo 0
Next ptitemwk

For Each ptitemmc In FieldMC.PivotItems
On Error Resume Next
ptitemmc.Delete
On Error GoTo 0
Next ptitemmc
' Test for valid filter value
On Error GoTo InvalidFilter1
FieldYEAR.PivotItems(NewYEAR).Visible = True
On Error GoTo 0

On Error GoTo InvalidFilter1
FieldWEEK.PivotItems(NewWEEK).Visible = True
On Error GoTo 0
On Error GoTo InvalidFilter1
FieldMC.PivotItems(NewMC).Visible = True
On Error GoTo 0
' Loop though PivotItems
For Each ptitemy In FieldYEAR.PivotItems
If ptitemy = NewYEAR Then
ptitemy.Visible = True
Else
ptitemy.Visible = False
End If
Next ptitemy
For Each ptitemwk In FieldWEEK.PivotItems
If ptitemwk = NewWEEK Then
ptitemwk.Visible = True
Else
ptitemwk.Visible = False
End If
Next ptitemwk
For Each ptitemmc In FieldMC.PivotItems
If ptitemmc = NewMC Then
ptitemmc.Visible = True
Else
ptitemmc.Visible = False
End If
Next ptitemmc

Sheet4.Cells(6, 12) = Sheet8.Cells(12, 1).Value
Sheet4.Cells(6, 13) = Sheet8.Cells(12, 2).Value
Sheet4.Cells(6, 11) = Sheet8.Cells(12, 3).Value
Sheet4.Cells(6, 10) = Sheet8.Cells(12, 4).Value
' Stop the code so it doesn't do the InvalidFilter bit

' This runs if there was an error in the test
InvalidFilter1:
Sheet4.Cells(6, 10) = 0
Sheet4.Cells(6, 11) = 0
Sheet4.Cells(6, 13) = 0
Sheet4.Cells(6, 12) = 0
 
Since your pivottables are based on OLAP datamodel, PivotField and PivotItem naming convention is different from conventional pivottable.

See below for list of pivotfield from your PivotTable.

Used below to get field names.
Code:
Sub Test()
Dim pvt As PivotTable
Dim pvF As PivotField

Set pvt = Worksheets("PVT STATS").PivotTables("PivotTable1")

For Each pvF In pvt.PivotFields
    Debug.Print pvF.Name
Next

End Sub

List of fields from above.
Code:
[YEAR].[YEAR].[YEAR]
[MONTH].[MONTH].[MONTH]
[WEEKNO].[WEEK #].[WEEK #]
[MAINCONTRACTOR].[MAIN CONTRACTOR].[MAIN CONTRACTOR]
[CI].[ISSUED CARD].[ISSUED CARD]
[Measures].[Count of ISSUED CARD]
 
Since your pivottables are based on OLAP datamodel, PivotField and PivotItem naming convention is different from conventional pivottable.

See below for list of pivotfield from your PivotTable.

Used below to get field names.
Code:
Sub Test()
Dim pvt As PivotTable
Dim pvF As PivotField

Set pvt = Worksheets("PVT STATS").PivotTables("PivotTable1")

For Each pvF In pvt.PivotFields
    Debug.Print pvF.Name
Next

End Sub

List of fields from above.
Code:
[YEAR].[YEAR].[YEAR]
[MONTH].[MONTH].[MONTH]
[WEEKNO].[WEEK #].[WEEK #]
[MAINCONTRACTOR].[MAIN CONTRACTOR].[MAIN CONTRACTOR]
[CI].[ISSUED CARD].[ISSUED CARD]
[Measures].[Count of ISSUED CARD]

FIRST ... thank you for reply and for your patience :)
2nd ... please give me an example about how to declare pvFY for example with [year].[year].[year]

Code:
Dim pvt As PivotTable
Dim pvFY As PivotField
Dim pvFM As PivotField
Dim pvFW As PivotField
Dim pvFMC As PivotField

Set pvt = Worksheets("PVT STATS").PivotTables("PivotTable1")

For Each pvF In pvt.PivotFields
    Debug.Print pvF.Name
Next
 
so i declared all the fields ... how do i filter based on a cell value? The code below is not working ...
Code:
Dim pvt As PivotTable
Dim pvFY As PivotField
Dim pvFM As PivotField
Dim pvFW As PivotField
Dim pvFMC As PivotField
Dim NewY As String
Dim NewM As String
Dim NewW As String
Dim NewMC As String

Set pvt = Worksheets("PVT STATS").PivotTables("PivotTable1")
Set pvFY = pvt.PivotFields("[YEAR].[YEAR].[YEAR]")
'Set pvFM = pvt.PivotFields("[MONTH].[MONTH].[MONTH]")
Set pvFW = pvt.PivotFields("[WEEKNO].[WEEK #].[WEEK #]")
Set pvFMC = pvt.PivotFields("[MAINCONTRACTOR].[MAIN CONTRACTOR].[MAIN CONTRACTOR]")
'Set pvFCI = pvt.PivotFields("[CI].[ISSUED CARD].[ISSUED CARD]") - I don't understand why is this line

For Each pvFY In pvt.PivotFields
    Debug.Print pvFY.Name
Next

For Each pvFM In pvt.PivotFields
    Debug.Print pvFM.Name
Next

For Each pvFW In pvt.PivotFields
    Debug.Print pvFW.Name
Next

For Each pvFMC In pvt.PivotFields
    Debug.Print pvFMC.Name
Next

NewY = Worksheets("PVT STATS").Range("A15").Value
NewW = Worksheets("PVT STATS").Range("C15").Value
NewMC = Worksheets("PVT STATS").Range("D15").Value

With pvt
pvFY.ClearAllFilters
pvFY.CurrentPage = NewM
pvFM.ClearAllFilters
pvFM.CurrentPage = NewM
pvFW.ClearAllFilters
pvFW.CurrentPage = NewW
pvFMC.ClearAllFilters
pvFMC.CurrentPage = NewMC
pvt.RefreshTable
End With
 
Umm, debug.Print is just to list all field names.

Just replace field names you used in your code with appropriate field name strings.

Edit: This also goes for PivotItem names. Just follow the naming convention found in link I gave you.
 
good morning!
i read the info from the link you gave me ... it applies to situations when you know exactly which pivot item you want to see ... for example you want to see the main contractor xyz and you write [maincontractor].[main contractor].&[xyz]
in my case i have on another sheet a table which contains columns year, month, main contractor ... and i need to filter the year from my pivot table based on the value of year cell a6, month - cell b6, week - c6, main contractor - d6 from the table from that sheet.
 
So those values are going to be in cell right? Just use that to construct a string.

For an example using "Year".

Code:
Dim yStr as String

yStr = "[YEAR].[YEAR].&[" & [A6].Value & "]"

pvFY.VisibleItemsList = Array(yStr)

Note: Depending on cell content, you may need to use Range.Text instead of Range.Value
 
Chihiro, please have a look on the presentation i have attached. Thanks a lot!
 

Attachments

  • excel file.rar
    571.8 KB · Views: 30
Back
Top