Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Pivot Table Criteria from Combo Box

Status
Not open for further replies.

mcongdon

Programmer
Mar 14, 2008
98
US
I have a worksheet with 2 pivot tables with criteria options of Apple or Orange. There is a separate drop down combo box with 2 options: Apple and Orange. My goal is to have the value in the combo box change the criteria of both pivot tables. Right now, the combination box sets the value of cell C1. If the user selects “Orange”, then cell C1 displays the number 2. Cell B1 has an index function to lookup the corresponding word out of a table on a separate sheet from the number in C1:
=index('Data table 1'!A5:A6,C1)
I use the following code to try and change the pivot table:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pt As PivotTable
    Dim pt2 As PivotTable
    If Not Intersect(Target(1, 1), Range("b1")) Is Nothing Then
        Set pt = Me.PivotTables("PivotTable1")
        With pt
            .RefreshTable
            .PivotFields("Fruit").CurrentPage = Range("b1").Value
            Set pt2 = Me.PivotTables("PivotTable2")
        End With
        With pt2
            .RefreshTable
            .PivotFields("Fruit").CurrentPage = Range("b1").Value
        End With
    End If
End Sub

This code works when I double click cell B1 and then press enter. It does not work by itself.
Any ideas on how to get this to work?
 
I tried changing the Worksheet_Change(ByVal Target As Range) to Worksheet_Calculate(ByVal Target As Range), but it encounters an error:

Compile Error:
Procedure declaration does not match description of event or procedure having the same name

 




Unless you disable events, you get a recursive change...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Range("b1")) Is Nothing Then
        With ActiveSheet.PivotTables("PivotTable1")
            .PivotFields("Fruit").CurrentPage.Name = Range("b1").Value
            .RefreshTable
        End With
        With ActiveSheet.PivotTables("PivotTable2")
            .PivotFields("Fruit").CurrentPage.Name = Range("b1").Value
            .RefreshTable
        End With
    End If
    Application.EnableEvents = True
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks Skip,
I get a Run-time error '5' on the line:

.PivotFields("Fruit").CurrentPage.Name=Range("b1").Value

I debugged and removed the .Name from it and it works, but I still need to go to edit mode on cell B1 and press enter to have the pivot tables update. The code is much cleaner now, but the tables still don't switch automatically..
Thanks!
 



Is there a formula in B1? Is CALCULATION set to AUTOMATIC?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Yes, the formula in B1 is:

=index('Data table 1'!A5:A6,C1)

The workbook is set to auto calculation, and the formula does change values. So it displays Apple when I switch the drop down to Apple. It doesn't change the pivot tables unless I double click B1 and then press enter though.
 
I tried to change the code to:
Code:
Private Sub Worksheet_Calculate()
    Dim pt As PivotTable
    Dim p2 As PivotTable
    Set pt = Me.PivotTables("PivotTable1")
    With pt
        .PivotFields("Fruit").CurrentPage = Range("b1").Value
        .RefreshTable
    End With
    With pt2
        .PivotFields("Fruit").CurrentPage = Range("b1").Value
        .RefreshTable
    End With
End Sub

This works once, but then slows down my whole system. I use excel 2007, but this worksheet is very small for testing purposes and it is taking forever for the whole sheet to stop flickering.
 




Did you CHANGE the statement to REFRESH the PT's to AFTER the PAGE field is assigned?

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Sorry to be difficult, but I'm not sure what you mean- can you elaborate just a bit?

Thanks a ton!
 



Your code has the Refresh BEFORE the assignment. Mine has it AFTER...
Code:
    With pt
        .PivotFields("Fruit").CurrentPage = Range("b1").Value
        .RefreshTable
    End With

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I did switch it to AFTER hoping that it would work, but it did not. I switched it back to BEFORE and it still does not work correctly. Is there a better event to use than Worksheet_Calculate()? It seems to be that it is constantly recalculating which freezes the whole sheet.
 
I figured out how to do what I wanted to do. I ended up reverting back to the Worksheet_Change() method and using a 2 part code.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pt As PivotTable
    Dim p2 As PivotTable
    If Not Intersect(Target(1, 1), Range("A1")) Is Nothing Then
        Set pt = Me.PivotTables("PivotTable1")
        With pt
            .RefreshTable
            .PivotFields("Fruit").CurrentPage = Range("A1").Value
            Set pt2 = Me.PivotTables("PivotTable2")
        End With
        With pt2
            .RefreshTable
            .PivotFields("Fruit").CurrentPage = Range("A1").Value
        End With
    End If
End Sub

Then I used a second bit of code on the drop down to make the target- A1 change:

Code:
Sub DropDown2_Change()
    Range("B1").Select
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

Thanks for all the help Skip!!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top