Pivot table with data validation

[vinwin06]

HI,

I required vba codings for pivot table but the value should be choose from the data validation i have created.

For example : I have two pivot tables in sheet1 and these two pivot table have a common column filed available so i have created the data validation in cell D6. Now i need to give reference to the cell D6 for both the pivot table on the column labels.

Based on the value selected on the drop down the pivot table need to be changed on the both pivot tables.

Regards,

VInwin

 

[Jerry Sullivan]

Hi VInwin,

You could try the code below...

There are two parts:
A worksheet event function that will trigger the code whenever you change your Cell that has the Data Validation list,
and one supporting function.

To use the code (always test new code on a copy of your workbook):
1. Right Click on the Tab of your Sheet that has the PivotTables
2. Select View Code
3. Copy and Paste the Sub Worksheet_Change Code below into the Sheet Code module
4. Edit the Names in Blue Font to match your Master PivotTable and Field Name

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sField As String, sDV_Address As String
    Dim ptTables As PivotTables
   
    sField = "Region"  'Field Name
    sDV_Address = "$B$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("PivotTable1").PivotFields(sField), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable2").PivotFields(sField), _
                vItems:=Target.Value)
    End With
       
CleanUp:
    Application.EnableEvents = True
End Sub

Then insert the function into a Standard Code Module
5. Press the keys ALT + I to activate the Insert menu
6. Press M to insert a Standard Module
7. Copy and Paste the function below into the Standard 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

 

[vinwin06]

I have tried with the codes given by you , but if i change the filter one table its not changing in other. I have attached the sample file for your reference.

i have made the pivot in sheet 4. Based on the value selected in cell E2 the pivot values in C4 and T4 needs to be changed.I am using excel 2007 version.

 

[Jerry Sullivan]

If you post the information requested below. I will revise the calling code for those parameters.

1. For Cell that has DataValidation Drop Down, what is the Sheet Name and Cell Address?
2. For first Pivot Table to update, what is the PivotTable Name and Sheet Name where it resides?
3. For second Pivot Table to update, what is the PivotTable Name and Sheet Name where it resides?

 

[vinwin06]

1. For Cell that has DataValidation Drop Down, what is the Sheet Name and Cell Address?
Its in Cell E2, "sheet4" is the sheet name

2. For first Pivot Table to update, what is the PivotTable Name and Sheet Name where it resides?

its also in sheet4 and pivot table name is "pivottable1"
3. For second Pivot Table to update, what is the PivotTable Name and Sheet Name where it resides?

its also in sheet4 and pivot table name is "pivottable3"

 

[Jerry Sullivan]

Place this code in the Sheet Code Module for Sheet4.
You'll need to replace "Region" in the code with the name of your Field to be filtered.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sField As String, sDV_Address As String
    Dim ptTables As PivotTables
   
    sField = "Region" 'Field Name
    sDV_Address = "$E$2" '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("PivotTable1").PivotFields(sField), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable3").PivotFields(sField), _
                vItems:=Target.Value)
    End With
       
CleanUp:
    Application.EnableEvents = True
End Sub

 

[vinwin06]

This is works for me. thanks a lot for your help

 

[jnerga]

Great script!! Possible to use this with 2 dorpdown cells? Need to add tDV_Address for same run as sDV_Address somehow in the script... Brgds Jnerga

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sField As String, sDV_Address As String
    Dim tField As String, tDV_Address As String
    Dim ptTables As PivotTables
   
    sField = "From_Name"  'Field Name
    sDV_Address = "$A$12" 'Cell with DV dropdown to select filter item.
    tField = "To_Name"  'Field Name
    tDV_Address = "$B$12" '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("PivotTable1").PivotFields(sField), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable2").PivotFields(tField), _
                vItems:=Target.Value)
    End With
       
CleanUp:
    Application.EnableEvents = True
End Sub

 

[Jerry Sullivan]

Hi Jnerga,

Yes, you could use this with 2 DV Cells. What is the relationship of your 2 DV Cells and 2 PivotTables?

The adaptation you posted looks like you're applying those separately (A12 is used as a filter for PivotTable1 and B12 is used as a filter for PivotTable2).

Is that what you want or should the values in A12 and B12 be applied as filters to both PivotTables?

 

[jnerga]

Hi Jnerga,

Yes, you could use this with 2 DV Cells. What is the relationship of your 2 DV Cells and 2 PivotTables?

The adaptation you posted looks like you're applying those separately (A12 is used as a filter for PivotTable1 and B12 is used as a filter for PivotTable2).

Is that what you want or should the values in A12 and B12 be applied as filters to both PivotTables?

Hi js411, tanks for fast answer!! Yes, I want to use values for A12 and B12 to be applied as filters to both PivotTables...help would be most appreciated. Brgds