Solved

Need a faster way to sync pivot table filters in Excel 2010

Posted on 2014-04-03
4
604 Views
Last Modified: 2014-04-03
Hi All

I have two pivot tables where i sync the filters as in the code below. Can somebody perhaps help me with a more effective/ faster way to get the same results?

I do set calculations to manual and disable events in the sub that calls this one.

Sub SinqPivotTableSupplierProfile()



Dim strFilterValue As String
Dim ptUpdate As PivotTable
Dim i As Long
Dim Pvi As PivotItem
Dim dic
Dim strSheetName As String
Dim strFilter() As String
Dim pt As PivotTable

Set pt = Sheets("Responses").PivotTables("PivotTable69")

Set dic = CreateObject("scripting.dictionary")
i = 0

'Find all pivot item names that are visible, add to array of visible items
    For Each Pvi In pt.PivotFields("Supplier").PivotItems
           If Pvi.Visible = True Then
                dic.Add Pvi.Name, i
                i = i + 1
           End If
    Next Pvi

'Loops through non target pivot tables and applies the filter to the supplier field
        For Each ptUpdate In Sheets("Summary").PivotTables
            If ptUpdate.Name = "SupplierProfiles" Then
                For Each Pvi In ptUpdate.PivotFields("Supplier").PivotItems
                    If dic.exists(Pvi.Name) Then
                       Pvi.Visible = True
                    End If
                Next Pvi

                For Each Pvi In ptUpdate.PivotFields("Supplier").PivotItems
                    If Not dic.exists(Pvi.Name) Then
                       Pvi.Visible = False
                    End If
                Next Pvi
            End If
        Next ptUpdate
        
End Sub

Open in new window

0
Comment
Question by:cErasmus
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 51

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 500 total points
ID: 39974453
Hi,

pls try

Sub SinqPivotTableSupplierProfile()

Application.ScreenUpdating = False

Dim strFilterValue As String
Dim ptUpdate As PivotTable
Dim i As Long
Dim Pvi As PivotItem
Dim dic
Dim strSheetName As String
Dim strFilter() As String
Dim pt As PivotTable, pt2 As PivotTable

Set pt = Sheets("Responses").PivotTables("PivotTable69")

Set dic = CreateObject("scripting.dictionary")
i = 0

'Find all pivot item names that are visible, add to array of visible items
    For Each Pvi In pt.PivotFields("Supplier").PivotItems
           If Pvi.Visible = True Then
                dic.Add Pvi.Name, i
                i = i + 1
           End If
    Next Pvi


    Set pt2 = Sheets("Summary").PivotTables("SupplierProfiles")
    For Each Pvi In pt2.PivotFields("Supplier").PivotItems
       If dic.Exists(Pvi.Name) Then
          Pvi.Visible = True
       Else
          Pvi.Visible = False
       End If
    Next Pvi


Application.ScreenUpdating = True

End Sub

Open in new window

Regards
0
 
LVL 1

Author Comment

by:cErasmus
ID: 39974721
Hi Rgonzo1971

Thank you for the reply. I have tried the code you supplied but the running time is almost exactly the same. with the old code being about 0.5 of a second faster. I have no idea why this is.
I did have screen updating set to false previously as well.
Do you perhaps have any other ideas on how i can sync the filters faster?
0
 
LVL 51

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 39974768
HI,

Instead of a dictionary you could try an array ( even if I do not think it will make a huge dîfference)

Sub SinqPivotTableSupplierProfile()

Application.ScreenUpdating = False

Dim strFilterValue As String
Dim ptUpdate As PivotTable
Dim i As Long
Dim Pvi As PivotItem
Dim dic
Dim strSheetName As String
Dim strFilter() As String
Dim pt As PivotTable, pt2 As PivotTable
Dim arr()
Set pt = Sheets("Responses").PivotTables("PivotTable69")
ReDim arr(0 To pt.PivotFields("Supplier").PivotItems.Count - 1)
'Set dic = CreateObject("scripting.dictionary")
i = 0

'Find all pivot item names that are visible, add to array of visible items
    For Each Pvi In pt.PivotFields("Supplier").PivotItems
           If Pvi.Visible = True Then
                arr(i) = Pvi.Name
                i = i + 1
           End If
    Next Pvi


    Set pt2 = Sheets("Summary").PivotTables("SupplierProfiles")
    For Each Pvi In pt2.PivotFields("Supplier").PivotItems
    IsInArray = Not IsError(Application.Match(Pvi.Name, arr, 0))
       If IsInArray Then
          Pvi.Visible = True
       Else
          Pvi.Visible = False
       End If
    Next Pvi


Application.ScreenUpdating = True

End Sub

Open in new window

Regards
0
 
LVL 1

Author Comment

by:cErasmus
ID: 39974804
Hi Rgonzo1971

You're right it doesn't make much of a difference. i have spent quite some time on finding the fastest way possible to sync filters and this has been the fastest way i could do it. I was hoping there might be another way but it doesn't seem like it. Thank you for the help
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question