Macro Pivottable with variable filters

S

SMitch54

New Member
Joined
Mar 5, 2012
Messages
10
I recorded a macro w/Excel 2010 which creates a pivot table and then filters by MODEL but then I found out the next time I ran the macro if one of the models filtered in my original setup is not there it halts w/unable to get pivotItems property of pivotfield class. I would like to write the code to filter by what is true rather than what is false or what ever will skip what is not in my report. Is this possible? Thanks in advance for your advice.

What I would be looking for is:
"TC*"
"ENA"
"IDM*"

Here is current code:

ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL").CurrentPage = _
"(All)"
With ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL")
.PivotItems("ACCUT32S").Visible = False
.PivotItems("AHDE").Visible = False
.PivotItems("AHDENV").Visible = False
.PivotItems("AHDF").Visible = False
.PivotItems("AHDM").Visible = False
.PivotItems("ALM").Visible = False
.PivotItems("BA115-35").Visible = False
.PivotItems("BNA").Visible = False
.PivotItems("BNA FL").Visible = False
.PivotItems("BOSCHGSA").Visible = False
.PivotItems("CBC CAM").Visible = False
.PivotItems("CH15").Visible = False
.PivotItems("CH15 3").Visible = False
.PivotItems("CHIP CAM").Visible = False
.PivotItems("CNT135-M").Visible = False
.PivotItems("COUNT1-E").Visible = False
.PivotItems("COUNT1-M").Visible = False
.PivotItems("COUNT-E").Visible = False
.PivotItems("CSP400UL").Visible = False
.PivotItems("D1700ALM").Visible = False
.PivotItems("DMPXR500").Visible = False
.PivotItems("EASYAIRE").Visible = False
.PivotItems("ECD").Visible = False
.PivotItems("ENA FL").Visible = False
.PivotItems("FCOUNT-E").Visible = False
.PivotItems("HAM VAT").Visible = False
.PivotItems("HANDKEY2").Visible = False
.PivotItems("HID RDR").Visible = False
.PivotItems("INOV-ES").Visible = False
.PivotItems("LEF BA").Visible = False
.PivotItems("LNXFNDVR").Visible = False
.PivotItems("LNXNDVR2").Visible = False
.PivotItems("MDDRAWER").Visible = False
.PivotItems("MOSL VAT").Visible = False
.PivotItems("MSC").Visible = False
.PivotItems("NC5588FL").Visible = False
.PivotItems("NCR 5588").Visible = False
.PivotItems("PACOM").Visible = False
.PivotItems("PELCOCAM").Visible = False
.PivotItems("PRESIDER").Visible = False
.PivotItems("RITPRNTR").Visible = False
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL")
.PivotItems("SD/LOCKR").Visible = False
.PivotItems("SDBOX").Visible = False
.PivotItems("SF1L3K4").Visible = False
.PivotItems("SF2L4").Visible = False
.PivotItems("SFER").Visible = False
.PivotItems("SFF").Visible = False
.PivotItems("TAB").Visible = False
.PivotItems("TELULAR").Visible = False
.PivotItems("TI1053ED").Visible = False
.PivotItems("TI1064EC").Visible = False
.PivotItems("TI1074IS").Visible = False
.PivotItems("TL2").Visible = False
.PivotItems("TX1064FL").Visible = False
.PivotItems("TX1064IC").Visible = False
.PivotItems("TX1074FL").Visible = False
.PivotItems("TX1074IS").Visible = False
.PivotItems("TX1075SA").Visible = False
.PivotItems("TX1077DU").Visible = False
.PivotItems("UC1K5").Visible = False
.PivotItems("UC1L1").Visible = False
.PivotItems("UNDEFEQP").Visible = False
.PivotItems("USPSCAM").Visible = False
.PivotItems("VAT").Visible = False
.PivotItems("VAT 30").Visible = False
.PivotItems("VAT CCTV").Visible = False
.PivotItems("VAT12EUG").Visible = False
.PivotItems("VAT21").Visible = False
.PivotItems("VAT23UG").Visible = False
.PivotItems("VAT24").Visible = False
.PivotItems("VD2LVV").Visible = False
.PivotItems("VDFTL1L").Visible = False
.PivotItems("VDTL2L").Visible = False
.PivotItems("VISTA").Visible = False
.PivotItems("VLT").Visible = False
End With
ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL"). _
EnableMultiplePageItems = True
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
You can try the Filter_PivotField_by_Patterns Function code below.

Copy all the code into a Standard VBA Code module.
It uses VBA's Like Operator for comparison, so you can use any of the
special characters for pattern matching such as *,?,#,~ that are allowed by Like.
(see VBA help for Like Operator for details).

Rich (BB code): 
Option Explicit
Option Compare Text 'for Case-Sensitive Match, change "Text" to: Binary

Sub TEST_Filter_by_Pattern()
    Dim vPatterns As Variant
    Dim PT As PivotTable
    
    vPatterns = Array("TC*", "ENA", "IDM*")
    Set PT = Sheets("Sheet1").PivotTables("PivotTable9")
    
    Call Filter_PivotField_by_Patterns( _
        pvtField:=PT.PivotFields("MODEL"), _
        vPatterns:=vPatterns)
End Sub

Private Function Filter_PivotField_by_Patterns(pvtField As PivotField, _
        vPatterns As Variant)
    Dim sItem1 As String, bTemp As Boolean, i As Long
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    If Not (IsArray(vPatterns)) Then
         vPatterns = Array(vPatterns)
    End If
    With pvtField
        .Parent.ManualUpdate = True
        For i = 1 To .PivotItems.Count
            bTemp = Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns)
            If bTemp Then
                sItem1 = .PivotItems(i).Visible = True
                Exit For
            End If
        Next i
        If sItem1 = "" Then
            MsgBox "No Pivot Items match filter patterns."
            GoTo CleanUp
        End If
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
 
        For i = 1 To .PivotItems.Count
           If .PivotItems(i).Visible <> Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns) Then
                .PivotItems(i).Visible = Not .PivotItems(i).Visible
           End If
        Next i
    End With
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

Private Function Matches_Pattern(sWhat As String, _
        vPatterns As Variant) As Boolean
    Dim i As Long
    For i = LBound(vPatterns) To UBound(vPatterns)
        If sWhat Like vPatterns(i) Then
            Matches_Pattern = True
            Exit Function
        End If
    Next i
    Matches_Pattern = False
End Function
 
Last edited:
Upvote 0
I missed a line of code in my last post.

Please add the line shown in Blue below.
Rich (BB code): 
Private Function Filter_PivotField_by_Patterns(pvtField As PivotField, _
        vPatterns As Variant)
    Dim sItem1 As String, bTemp As Boolean, i As Long
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    If Not (IsArray(vPatterns)) Then
         vPatterns = Array(vPatterns)
    End If
    With pvtField
        .Parent.ManualUpdate = True
        For i = 1 To .PivotItems.Count
            bTemp = Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns)
            If bTemp Then
                sItem1 = .PivotItems(i).Visible = True
                Exit For
            End If
        Next i
        If sItem1 = "" Then
            MsgBox "No Pivot Items match filter patterns."
            GoTo CleanUp
        End If
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
         .PivotItems(i).Visible = True
        For i = 1 To .PivotItems.Count
           If .PivotItems(i).Visible <> Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns) Then
                .PivotItems(i).Visible = Not .PivotItems(i).Visible
           End If
        Next i
    End With
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function
 
Upvote 0
Now i'm getting a compile error mesage, Ambiguous name detected: TEST_Filter_by_patteren at line Sub TEST_Filter_by_Pattern ()
 
Upvote 0
With my lack of experiance I could be doing something else wrong.

Here is all of my revised code with the compile error message:


ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 3").IncrementLeft -348
ActiveSheet.Shapes("Chart 3").IncrementTop 141.75
ActiveWindow.SmallScroll Down:=12
ActiveSheet.Shapes("Chart 3").ScaleWidth 1.0333333333, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 3").ScaleHeight 1.0954862934, msoFalse, _
msoScaleFromTopLeft
pivotaddress = ActiveWorkbook.Sheets("Report").[A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Report!" & pivotaddress).CreatePivotTable _
TableDestination:="Charts!R26C8", TableName:="PivotTable9", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.Name = "Charts"
Sheets("Charts").Select
Cells(26, 8).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range("Charts!$H$26:$N$39")
ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
"PivotTable9").PivotFields("CALL_BASE"), "Count of CALL_BASE", xlCount
With ActiveSheet.PivotTables("PivotTable9").PivotFields("CSE Team")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("BILL_DSC")
.Orientation = xlPageField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("TECH_NAME")
.Orientation = xlPageField
.Position = 2
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("-STATUS-")
.Orientation = xlPageField
.Position = 3
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL")
.Orientation = xlPageField
.Position = 4
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("SRV_CDE")
.Orientation = xlPageField
.Position = 5
End With
With ActiveSheet.PivotTables("PivotTable9").PivotFields("DEV")
.Orientation = xlPageField
.Position = 6
End With
ActiveSheet.PivotTables("PivotTable9").PivotFields("BILL_DSC").CurrentPage = _
"D"
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.PivotTables("PivotTable9").PivotFields("-STATUS-").CurrentPage = _
"COMPLETE"
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL").CurrentPage = _
"(All)"
Sub TEST_Filter_by_Pattern()
 Dim vPatterns As Variant
Dim PT As PivotTable

vPatterns = Array("TC*", "ENA", "IDM*")
Set PT = Sheets("Sheet1").PivotTables("PivotTable9")

Call Filter_PivotField_by_Patterns( _
pvtField:=PT.PivotFields("MODEL"), _
vPatterns:=vPatterns)
End Sub
Private Function Filter_PivotField_by_Patterns(pvtField As PivotField, _
vPatterns As Variant)
Dim sItem1 As String, bTemp As Boolean, i As Long
On Error GoTo CleanUp
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Not (IsArray(vPatterns)) Then
vPatterns = Array(vPatterns)
End If
With pvtField
.Parent.ManualUpdate = True
For i = 1 To .PivotItems.Count
bTemp = Matches_Pattern(sWhat:=.PivotItems(i), _
vPatterns:=vPatterns)
If bTemp Then
sItem1 = .PivotItems(i).Visible = True
Exit For
End If
Next i
If sItem1 = "" Then
MsgBox "No Pivot Items match filter patterns."
GoTo CleanUp
End If
If .Orientation = xlPageField Then .EnableMultiplePageItems = True
.PivotItems(i).Visible = True
For i = 1 To .PivotItems.Count
If .PivotItems(i).Visible <> Matches_Pattern(sWhat:=.PivotItems(i), _
vPatterns:=vPatterns) Then
.PivotItems(i).Visible = Not .PivotItems(i).Visible
End If
Next i
End With
CleanUp:
pvtField.Parent.ManualUpdate = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function
Private Function Matches_Pattern(sWhat As String, _
vPatterns As Variant) As Boolean
Dim i As Long
For i = LBound(vPatterns) To UBound(vPatterns)
If sWhat Like vPatterns(i) Then
Matches_Pattern = True
Exit Function
End If
Next i
Matches_Pattern = False
End Function
ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL"). _
EnableMultiplePageItems = True
ActiveSheet.ChartObjects("Chart 4").Activate
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "U03 Call Total"
Selection.Format.TextFrame2.TextRange.Characters.Text = "U03 Call Total"
With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.Format.TextFrame2.TextRange.Characters(9, 1).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
With Selection.Format.TextFrame2.TextRange.Characters(10, 5).Font
.BaselineOffset = 0
.Bold = msoTrue
.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
.Size = 18
.Italic = msoFalse
.Kerning = 12
.Name = "+mn-lt"
.UnderlineStyle = msoNoUnderline
.Strike = msoNoStrike
End With
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 4").IncrementLeft 73.5
ActiveSheet.Shapes("Chart 4").IncrementTop -6
ActiveSheet.Shapes("Chart 4").ScaleWidth 1.2055888224, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 4").ScaleHeight 1.0711807378, msoFalse, _
msoScaleFromTopLeft
ActiveChart.ChartArea.Select
ActiveSheet.Shapes("Chart 2").ScaleWidth 0.9034690799, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 2").ScaleHeight 0.9969834092, msoFalse, _
msoScaleFromTopLeft
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
End Function
 
Upvote 0
SMitch54 said:
Now i'm getting a compile error mesage, Ambiguous name detected: TEST_Filter_by_patteren at line Sub TEST_Filter_by_Pattern ()
Click to expand...

That message means you have two Subs in the VBA Project with the same name. You should delete or rename one of those.

Regarding the other code you posted. I'd suggest you get my code to work on a standalone basis with your PivotTable already created, instead of trying to integrate my code into some other code you have.

If that works, I can help you integrate the two parts.
 
Upvote 0
Your code works perfectly as a stand alone macro, thanks.

I started trying to insert it in my code and get a complile error as marked in the code below where red. (Only comments may appear after EndSub, End Function, or End Property)

Thanks again for any help you can give.


Code: 
Sub ChartF20VATESPU03()
'
' ChartF20VATESP Macro
'
'
    Sheets.Add After:=Sheets(Sheets.Count)
    Application.Run "updatecc"
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Charts"
    pivotaddress = ActiveWorkbook.Sheets("Report").[A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Report!" & pivotaddress).CreatePivotTable _
    TableDestination:="Charts!R1C1", TableName:="PivotTable6", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.Name = "Charts"
    Sheets("Charts").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Charts!$A$1:$G$14")
    ActiveSheet.PivotTables("PivotTable6").AddDataField ActiveSheet.PivotTables( _
        "PivotTable6").PivotFields("CALL_BASE"), "Count of CALL_BASE", xlCount
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("CSE Team")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("BILL_DSC")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("MODEL")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("-STATUS-")
        .Orientation = xlPageField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("SRV_CDE")
        .Orientation = xlPageField
        .Position = 4
    End With
    ActiveSheet.PivotTables("PivotTable6").PivotFields("BILL_DSC").CurrentPage = _
        "D"
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.PivotTables("PivotTable6").PivotFields("MODEL").CurrentPage = _
        "(All)"
        Dim vPatterns As Variant
    Dim PT As PivotTable
 
    vPatterns = Array("TC*", "ENA", "IDM*")
    Set PT = Sheets("Charts").PivotTables("PivotTable6")
 
    Call Filter_PivotField_by_Patterns( _
        pvtField:=PT.PivotFields("MODEL"), _
        vPatterns:=vPatterns)
End Sub
Private Function Filter_PivotField_by_Patterns(pvtField As PivotField, _
        vPatterns As Variant)
    Dim sItem1 As String, bTemp As Boolean, i As Long
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    If Not (IsArray(vPatterns)) Then
         vPatterns = Array(vPatterns)
    End If
    With pvtField
        .Parent.ManualUpdate = True
        For i = 1 To .PivotItems.Count
            bTemp = Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns)
            If bTemp Then
                sItem1 = .PivotItems(i).Visible = True
                Exit For
            End If
        Next i
        If sItem1 = "" Then
            MsgBox "No Pivot Items match filter patterns."
            GoTo CleanUp
        End If
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
         .PivotItems(i).Visible = True
        For i = 1 To .PivotItems.Count
           If .PivotItems(i).Visible <> Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns) Then
                .PivotItems(i).Visible = Not .PivotItems(i).Visible
           End If
        Next i
    End With
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function
[COLOR=blue]Private Function Matches_Pattern(sWhat As String, _[/COLOR]
[COLOR=blue]       vPatterns As Variant) As Boolean[/COLOR]
    Dim i As Long
    For i = LBound(vPatterns) To UBound(vPatterns)
        If sWhat Like vPatterns(i) Then
            Matches_Pattern = [COLOR=red][B]True[/B][/COLOR]
            Exit Function
        End If
    Next i
    Matches_Pattern = False
End Function
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("MODEL"). _
        EnableMultiplePageItems = True
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.PivotTables("PivotTable6").PivotFields("-STATUS-").CurrentPage = _
        "COMPLETE"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.PivotTables("PivotTable6").PivotFields("SRV_CDE").CurrentPage = _
        "TR"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "F20 Call Total"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "F20 Call Total"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 1).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(10, 5).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 1").IncrementLeft -443.25
    ActiveSheet.Shapes("Chart 1").IncrementTop -126
    ActiveSheet.Shapes("Chart 1").ScaleWidth 1.0354166667, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 1").ScaleHeight 1.1232640712, msoFalse, _
        msoScaleFromTopLeft
    pivotaddress = ActiveWorkbook.Sheets("Report").[A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Report!" & pivotaddress).CreatePivotTable _
    TableDestination:="Charts!R2C8", TableName:="PivotTable7", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.Name = "Charts"
    Sheets("Charts").Select
    Cells(2, 8).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Charts!$H$2:$N$15")
    ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
        "PivotTable7").PivotFields("CALL_BASE"), "Count of CALL_BASE", xlCount
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("CSE Team")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("BILL_DSC")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("-STATUS-")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("SRV_CDE")
        .Orientation = xlPageField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("DEV")
        .Orientation = xlPageField
        .Position = 4
    End With
    ActiveSheet.PivotTables("PivotTable7").PivotFields("BILL_DSC").CurrentPage = _
        "D"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.PivotTables("PivotTable7").PivotFields("-STATUS-").CurrentPage = _
        "COMPLETE"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.PivotTables("PivotTable7").PivotFields("SRV_CDE").CurrentPage = _
        "TR"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.PivotTables("PivotTable7").PivotFields("DEV").CurrentPage = "VAT"
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "VAT Call Total"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "VAT Call Total"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 1).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(10, 5).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("TECH_NAME")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable7").PivotFields("TECH_NAME")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.Shapes("Chart 2").IncrementLeft 78
    ActiveSheet.Shapes("Chart 2").IncrementTop -127.5
    ActiveSheet.Shapes("Chart 2").ScaleWidth 1.1609403255, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 2").ScaleHeight 1.1510418489, msoFalse, _
        msoScaleFromTopLeft
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    pivotaddress = ActiveWorkbook.Sheets("Report").[A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Report!" & pivotaddress).CreatePivotTable _
    TableDestination:="Charts!R26C1", TableName:="PivotTable8", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.Name = "Charts"
    Sheets("Charts").Select
    Cells(26, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Charts!$A$26:$G$39")
    ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
        "PivotTable8").PivotFields("CALL_BASE"), "Count of CALL_BASE", xlCount
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("CSE Team")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("BILL_DSC")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("TECH_NAME")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("-STATUS-")
        .Orientation = xlPageField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("SRV_CDE")
        .Orientation = xlPageField
        .Position = 4
    End With
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("DEV")
        .Orientation = xlPageField
        .Position = 5
    End With
    ActiveSheet.PivotTables("PivotTable8").PivotFields("BILL_DSC").CurrentPage = _
        "D"
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveSheet.PivotTables("PivotTable8").PivotFields("-STATUS-").CurrentPage = _
        "COMPLETE"
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveSheet.PivotTables("PivotTable8").PivotFields("SRV_CDE").CurrentPage = _
        "TR"
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveSheet.PivotTables("PivotTable8").PivotFields("DEV").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("PivotTable8").PivotFields("DEV")
        .PivotItems("MSC").Visible = False
        .PivotItems("TAB").Visible = False
        .PivotItems("VAT").Visible = False
        .PivotItems("VLT").Visible = False
        .PivotItems("ZZZ").Visible = False
    End With
    ActiveSheet.PivotTables("PivotTable8").PivotFields("DEV"). _
        EnableMultiplePageItems = True
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "ESP Calls Total"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "ESP Calls Total"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 15).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 15).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 3").IncrementLeft -348
    ActiveSheet.Shapes("Chart 3").IncrementTop 141.75
    ActiveWindow.SmallScroll Down:=12
    ActiveSheet.Shapes("Chart 3").ScaleWidth 1.0333333333, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 3").ScaleHeight 1.0954862934, msoFalse, _
        msoScaleFromTopLeft
    pivotaddress = ActiveWorkbook.Sheets("Report").[A1].CurrentRegion.Address(ReferenceStyle:=xlR1C1)
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="Report!" & pivotaddress).CreatePivotTable _
    TableDestination:="Charts!R26C8", TableName:="PivotTable9", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.Name = "Charts"
    Sheets("Charts").Select
    Cells(26, 8).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Charts!$H$26:$N$39")
    ActiveSheet.PivotTables("PivotTable9").AddDataField ActiveSheet.PivotTables( _
        "PivotTable9").PivotFields("CALL_BASE"), "Count of CALL_BASE", xlCount
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("CSE Team")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("BILL_DSC")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("TECH_NAME")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("-STATUS-")
        .Orientation = xlPageField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL")
        .Orientation = xlPageField
        .Position = 4
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("SRV_CDE")
        .Orientation = xlPageField
        .Position = 5
    End With
    With ActiveSheet.PivotTables("PivotTable9").PivotFields("DEV")
        .Orientation = xlPageField
        .Position = 6
    End With
    ActiveSheet.PivotTables("PivotTable9").PivotFields("BILL_DSC").CurrentPage = _
        "D"
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveSheet.PivotTables("PivotTable9").PivotFields("-STATUS-").CurrentPage = _
        "COMPLETE"
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL").CurrentPage = _
        "(All)"
   Dim vPatterns As Variant
    Dim PT As PivotTable
 
    vPatterns = Array("TC*", "ENA", "IDM*")
    Set PT = Sheets("Sheet1").PivotTables("PivotTable9")
 
    Call Filter_PivotField_by_Patterns2( _
        pvtField:=PT.PivotFields("MODEL"), _
        vPatterns:=vPatterns)
End Function
Private Function Filter_PivotField_by_Patterns2(pvtField As PivotField, _
       vPatterns As Variant)
    Dim sItem1 As String, bTemp As Boolean, i As Long
    On Error GoTo CleanUp
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    If Not (IsArray(vPatterns)) Then
         vPatterns = Array(vPatterns)
    End If
    With pvtField
        .Parent.ManualUpdate = True
        For i = 1 To .PivotItems.Count
            bTemp = Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns)
            If bTemp Then
                sItem1 = .PivotItems(i).Visible = True
                Exit For
            End If
        Next i
        If sItem1 = "" Then
            MsgBox "No Pivot Items match filter patterns."
            GoTo CleanUp
        End If
        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
         .PivotItems(i).Visible = True
        For i = 1 To .PivotItems.Count
           If .PivotItems(i).Visible <> Matches_Pattern(sWhat:=.PivotItems(i), _
                vPatterns:=vPatterns) Then
                .PivotItems(i).Visible = Not .PivotItems(i).Visible
           End If
        Next i
    End With
CleanUp:
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function
Private Function Matches_Pattern3(sWhat As String, _
       vPatterns As Variant) As Boolean
    Dim i As Long
    For i = LBound(vPatterns) To UBound(vPatterns)
        If sWhat Like vPatterns(i) Then
            Matches_Pattern3 = True
            Exit Function
        End If
    Next i
    Matches_Pattern = False
End Function
    ActiveSheet.PivotTables("PivotTable9").PivotFields("MODEL"). _
        EnableMultiplePageItems = True
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "U03 Call Total"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "U03 Call Total"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 8).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(9, 1).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(10, 5).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 4").IncrementLeft 73.5
    ActiveSheet.Shapes("Chart 4").IncrementTop -6
    ActiveSheet.Shapes("Chart 4").ScaleWidth 1.2055888224, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 4").ScaleHeight 1.0711807378, msoFalse, _
        msoScaleFromTopLeft
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Chart 2").ScaleWidth 0.9034690799, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 2").ScaleHeight 0.9969834092, msoFalse, _
        msoScaleFromTopLeft
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
End Function
 
Upvote 0
Much of the code you posted isn't placed cleanly within Functions or Subs.

For example:
Rich (BB code): 
Private Function Matches_Pattern(sWhat As String, _
       vPatterns As Variant) As Boolean
    Dim i As Long
    For i = LBound(vPatterns) To UBound(vPatterns)
        If sWhat Like vPatterns(i) Then
            Matches_Pattern = True
            Exit Function
        End If
    Next i
    Matches_Pattern = False
End Function
    With ActiveSheet.PivotTables("PivotTable6").PivotFields("MODEL"). _
        EnableMultiplePageItems = True
    ActiveSheet.ChartObjects("Chart 2").Activate
   '............continues......


If you are new to writing VBA, I'd strongly encourage you to start with the code that I posted as your base (which you have done),
then extend the code in very small increments (1 line at a time if needed) and test each increment to make sure it compiles and does what you want it to do.

I'll be glad to help as needed if you'll take that approach. :)
 
Upvote 0
Thanks, I have little to no experience in writing code but would like to learn. I started this mess by recording a macro in Excel but later found problems with the macro when the filtered items are missing. I was hoping to get some good code to insert but I see it is more complicated than that to get good code. I will try what you suggested and appreciate your help.

Thanks, again
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
PivotTable: Filter out pivotitems less than a date variable
Replies
0
Views
272
NGonzalez
N
M
  • Solved
VBA to apply a filter to a pivot table
Replies
4
Views
3K
Moosles
M
ChrisMcIntyre
  • Question
VBA to edit PivotTable
Replies
0
Views
418
ChrisMcIntyre
ChrisMcIntyre
T
  • Question
Filtering for 2 values in a PivotTable VBA
Replies
0
Views
663
Tregs
T
B
  • Question
VBA Pivot item filter using selection
Replies
0
Views
2K
Bablu
B

Forum statistics

Threads
1,217,364
Messages
6,136,117
Members
449,993
Latest member
Sphere2215

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top