How to Place a Pivot Chart in a Specific Cell and Format the Chart and Plot Areas

I simplified your code by doing all the Borders at once and by deleting statements that selected or activated worksheets or ranges.

I changed the statements to position the chart so it would be relative to the PivotTable. You'll need to put similar statements inside a Worksheet_Change event sub if you want the chart to move as the user changes the PivotTable.

I added statements to set the forecolor of the ChartArea and PlotArea.

Sub CreatePT()
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False

' Create Audit Criteria Chart
    Sheets.Add

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim cht As Chart
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        With .PlotArea.Format.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorAccent1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Solid
        End With
        With .ChartArea.Format.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorAccent6
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0.6000000238
                .Transparency = 0
                .Solid
        End With
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
                
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
    
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 600
        .Width = 600
    End With
End Sub

Select allOpen in new window

byundt:

In regards to the statements for the Forecolors of the ChartArea and PlotArea, the colors are not what I need.  

I had actually inserted the following code that gives me the colors I want:

        ActiveSheet.ChartObjects("Chart 1").Activate
        With ActiveChart.Parent
            .Chart.ChartArea.Interior.ColorIndex = 48
            .Chart.PlotArea.Interior.ColorIndex = 15
        End With

Select allOpen in new window

I'm not familiar with the ThemeColors so not sure what to use to get the colors I want.  Is there a list somewhere that shows the Colors for the ThemeColors?

I also changed the Height from 600 to 270.

Also, in regards to writing similar code for if a user changes the Pivot Table so that the position of the Pivot Chart adjusts accordingly, I tried copying some of the code from the main code into the "Worksheet_Change", but it didn't work.  Can you assist me with this also?

Here is the code that I copied from the main code to the "Worksheet_Change", that didn't work:

Sub Worksheet_Change()

   Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
      
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With

End Sub

Select allOpen in new window

Thanks,
gdunn59

I incorporated your background color changes in the sub below:

Sub CreatePT()
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False


    On Error Resume Next
    Set ws = Worksheets("Q1 Audit Criteria_Graph")
    On Error GoTo 0
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If
' Create Audit Criteria Chart
    Sheets.Add

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartArea.Interior.ColorIndex = 48
        .PlotArea.Interior.ColorIndex = 15
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveWorkbook.ShowPivotChartActiveFields = False
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
                
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
    
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With
    
    Application.EnableEvents = True
End Sub

Select allOpen in new window

The following code in ThisWorkbook code pane will take care of shifting the chart and resetting the borders as the PivotTable is changed:
 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Select Case Sh.Name
Case "Q1 Audit Criteria_Graph"
    If (Sh.PivotTables.Count > 0) And (Sh.ChartObjects.Count > 0) Then
        Set rg = Sh.PivotTables(1).TableRange2
        If Not Intersect(rg, Target) Is Nothing Then
            Application.EnableEvents = False
            Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
            Application.EnableEvents = True
            With Sh.Cells.Borders
                .LineStyle = xlNone
            End With
            Cells.Borders.LineStyle = xlLineStyleNone
            With rg.Borders
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
    End If
End Select
End Sub

Select allOpen in new window

Brad

Your code would have worked had you used the correct Worksheet_Change first statement, and if you had placed it in the code pane for the newly added worksheet.

Rather than write the required code to the worksheet code pane, I decided to use a Workbook_SheetChange sub as shown in the snippet in my preceding comment. You can put that code in at design time, and it will be ready to run when the user runs the macro creating the PivotTable and PivotChart on the newly added worksheet.

I've attached a sample workbook with both macros installed in the correct locations.

Brad
PivotChartPlacerQ28148511.xlsm

Brad,

Ok.  I tried it but it didn't seem to work exactly.  Didn't move the Chart over to the right far enough.  It is overlapped on the Pivot Table.

When I get a minute, I will open your attached spreadsheet and try that, maybe I didn't something wrong.

 One I try it, I will let you know the outcome.

Thank you,

gdunn59

Of course, if the PivotTable were to the right or bottom of the PivotChart, then nothing would need to move when the user plays with the PivotTable.

Brad,

It is to the right of the Pivot Table now, that is why when the Pivot Table expands the Pivot Chart is not moving over far enough to the right, so it is overlapping on the Table.

Thanks,
gdunn59

Brad,

I downloaded your spreadsheet and changed the filter of the data, and it worked. It moved the Pivot Chart to the right accordingly.

But when I cut and pasted your code from your spreadsheet and replaced my code in my spreadsheet with yours, it doesn't work.

I didn't see anything in your spreadsheet for Worksheet_Change code.  The only code I see is the one for "CreatePT".

What am I doing wrong?

Thanks,
gdunn59

Brad,

I just can't seem to get it to work when I put the code in my own spreadsheet.  It works if I try it with your spreadsheet.

Here is my entire code (which includes code for several sheets).  Two of those sheets are Pivot Tables/Charts and they both would need to adjust:

The Code to Create the Pivot Tables/Charts:

Sub macQtrlyAssocReport()
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
    Set ws = Worksheets("Q1 Audit Criteria_Graph")
    On Error GoTo 0
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If


' Create Monthly Summary
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R35C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveSheet.Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
        .Name = "Assoc Error"
    End With
'    Range("H2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Month")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
        .Name = "Audit Criteria Associate"
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Audit Criteria Associate")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Employee").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "", xlCount

    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error").CurrentPage = _
        "Y"
    ActiveSheet.PivotTables("Summary").PivotFields("Month").CurrentPage = _
        "(All)"
    ActiveSheet.PivotTables("Summary").PivotFields("Month"). _
        EnableMultiplePageItems = True

    ActiveSheet.PivotTables("Summary").ShowDrillIndicators = False

    Range("A7").Select
    Selection.Value = "Audit Criteria Associate"

    Range("A1:A4").Select
    Selection.Font.Bold = True

    Range("B1:B4").Select
    Selection.Font.Italic = True
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Summary"

' Create Quarterly Summary By Associate
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Assoc")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Assoc").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Assoc").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
'    Dim ws As Worksheet
'    Dim cel As Range, rg As Range
'    Dim i As Long
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data

' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
' Format certain Columns
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("A1:A2").Select
    Selection.Font.Bold = True

    Range("B1:B2").Select
    Selection.Font.Italic = True

' Move the Sheet to put in a particular order
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)

' Wrap Text in Column A
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select

' Rename the Active Sheet
    ActiveSheet.Name = "Q1 Summary by Associate"


' Create Quarterly Summary By Audit Criteria
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Audit Criteria", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A6").Select
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Criteria")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Audit Criteria").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data


' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("B1:B2").Select
    Selection.Font.Italic = True
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select
    ActiveSheet.Name = "Q1 Summary By Audit Criteria"

    
' Create Audit Criteria Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
   With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim cht As Chart
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
'    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 600
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    
' Create Associate Error Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Associate Error_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlColumnStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartArea.Interior.ColorIndex = 48
        .PlotArea.Interior.ColorIndex = 15
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Associate Error_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 8)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Associate Error_Graph"


' remove any sheets that are not named and are blank
Application.DisplayAlerts = False

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True


' Move focus back to Summary Sheet
Sheets("Summary").Select
Range("A8").Select

' Save Workbook
'activeworkbook.SaveAs "Test", xls,

Application.ScreenUpdating = True

End Sub

Select allOpen in new window

The Code when the Pivot Table changes and Pivot Chart needs to change/adjust:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Select Case Sh.Name
Case "Q1 Audit Criteria_Graph"
    If (Sh.PivotTables.Count > 0) And (Sh.ChartObjects.Count > 0) Then
        Set rg = Sh.PivotTables(1).TableRange2
        If Not Intersect(rg, Target) Is Nothing Then
            Application.EnableEvents = False
            Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
            Application.EnableEvents = True
            With Sh.Cells.Borders
                .LineStyle = xlNone
            End With
            Cells.Borders.LineStyle = xlLineStyleNone
            With rg.Borders
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If
    End If
End Select
End Sub

Select allOpen in new window

Can you please check my code and see what I'm doing wrong?

Thanks,

gdunn59

I didn't see anything in your spreadsheet for Worksheet_Change code.  The only code I see is the one for "CreatePT".

My guess is that the Workbook_SheetChange sub is not installed in the right place in your workbook--and that is why it isn't working.

In the Project Explorer on the left side of the VBA window, you will see each of the worksheets, ThisWorkbook and Module1. The Workbook_SheetChange sub goes in the ThisWorkbook code pane--doubleclick it in the Project Explorer to display the associated code pane. The Workbook_SheetChange sub won't work at all if installed anywhere else.

If it still isn't working, could you post your workbook? Or if you don't want to expose it to the entire world, if you send it to me by email (my address is in my Experts-Exchange member profile), I'll be glad to do it for you.

Your macQtrlyAssocReport macro will run a lot faster and be easier to maintain if you eliminate all the .Activate and .Select statements. I did this for you in the portion of the code that you had previously posted.

It's a simple, but somewhat tedious process to eliminate the .Select and .Activate statements. Instead of:

    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With

Select allOpen in new window

You do this:

    Range("A5").Value = "Audit Criteria Associate"

Select allOpen in new window

You'll see other examples in the code that I had previously posted.

Brad

Brad,

I will check it out and let you know.  How late will you be able to assist me with this?

I need to leave to run some errands before my credit union closes, so I can't check it right now.

Thanks,

gdunn59

I'm in Central time zone, and am currently at home. I should be able to assist you until quite late tonight.

Brad

Brad,

Sorry.  I thought I had submitted this earlier today around 5:00 p.m. (MST).  I pressed submit but I guess it didn't go because I didn't give a description for the attachment.  I was rushing to get out of here to make it to the bank.

Anyway, I still can't get it to work.  I went through the Explorer and placed it where you said.

I have attached my spreadsheet for you to work on. THANK YOU THANK YOU THANK YOU.

I did not run the macro and create the other sheets.  It just has the "Detail" sheet in it.

Thanks again very much for all your assistance.

gdunn59
Quarterly-Assoc-Report-EE.xlsm

The cause of your frustration with the chart not moving was the fact that events were left turned off after your macQtrlyAssocReport macro ran. I turned them off in my CreatePT sub to avoid triggering the Workbook_SheetChange macro while my original macro was running, then turned them back on at the end of the macro. The statement turning events back on was omitted from your macQtrlyAssocReport after you integrated my code, however. As a result, the Workbook_SheetChange sub was never being triggered. Sub macQtrlyAssocReport needs to end like this:

Application.EnableEvents = True

End Sub

Select allOpen in new window

Since you have more than one worksheet with a PivotChart, you might want each one to have the same chart moving feature. If so, change the Workbook_SheetChange sub to this:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Dim bChartSelected As Boolean
If (Sh.PivotTables.Count = 1) And (Sh.ChartObjects.Count = 1) Then
    Set rg = Sh.PivotTables(1).TableRange2
    If Not Intersect(rg, Target) Is Nothing Then
        Application.EnableEvents = False
        Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
        Application.EnableEvents = True
        If Selection.Name = "Chart" Then
            bChartSelected = True
            Sh.Cells(1, 1).Select
        End If
        With Sh.Cells.Borders
            .LineStyle = xlNone
        End With
        Cells.Borders.LineStyle = xlLineStyleNone
        With rg.Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        If bChartSelected = True Then Sh.ChartObjects(1).Select
    End If
End If
End Sub

Select allOpen in new window

The Workbook_SheetChange sub also includes logic to handle the possibility that the user is using the PivotChart dropdown to change the number of months being displayed. If so, you need to select a worksheet cell to avoid a run-time error when changing the Borders on the worksheet cells.

I deleted the Worksheet_Change sub from the bottom of Module1. It won't ever run in that location.

I also deleted the statement turning ScreenUpdating back on at the end of your code. Excel automatically restores ScreenUpdating when macro execution stops, so there is no need for doing so programmatically. Furthermore, I have noticed extra screen blinking when a sequence of macros turn ScreenUpdating back on--so I delete those statements as a matter of "good practice" when responding to Experts-Exchange questions.

The attached workbook contains the code tweaks discussed in this Comment.

Brad
Quarterly-Assoc-Report-EE-Q28148.xlsm

Brad,

I tried the new code, but I'm getting an error in the SheetChange on Line 10 of the code:

     If Selection.Name = "Chart" Then

I am getting the following error:

    Run-time error '1004'
    Application-defined or object-defined error

Oops! I tested chart selections, but not PivotTable selections.

Try this Workbook_SheetChange sub instead:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Dim obj As Object
If (Sh.PivotTables.Count = 1) And (Sh.ChartObjects.Count = 1) Then
    Set rg = Sh.PivotTables(1).TableRange2
    If Not Intersect(rg, Target) Is Nothing Then
        Application.EnableEvents = False
        Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
        Set obj = Selection
        Sh.Cells(1, 1).Select
        With Sh.Cells.Borders
            .LineStyle = xlNone
        End With
        Cells.Borders.LineStyle = xlLineStyleNone
        With rg.Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        obj.Select
        Application.EnableEvents = True
    End If
End If
End Sub

Select allOpen in new window

Quarterly-Assoc-Report-EE-Q28148.xlsm

Brad,

Thanks, your last posting worked like a charm.

I have increased the points to 500 because you have provided so much information for me.

I did have one other thing.  I did this a few years back, but I haven't been able to find the code that I used, and I haven't been able to figure it out.  What I need is VBA code to do a File SaveAs and have it save to a specific path in a .xls format (because the original document is a Template), but allow the user to enter the filename.  I don't want the user to be able to overwrite the Template.  They need to save it with a different filename and xls format.

Thanks,
gdunn59

Oops, forgot to increase the points.

Thanks,
gdunn59

You can use Application.GetSaveAsFilename to display a file browse dialog to allow the user to pick a file name.

Sub Saver()
Dim f As String, flPath As String, flName As String
Dim i As Long
flPath = "X:\VBA\Sample '13\"   'Change to your desired path
f = Application.GetSaveAsFilename(flPath & "*.xls", FileFilter:="Excel files (*.xls),*.xls", _
    Title:="Choose the desired *.xls file name and location, then click 'Save'")
If f <> "False" Then
    i = InStrRev(f, Application.PathSeparator)
    flName = Mid(f, i + 1)
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel8   'Save as .xls file
    Else
        MsgBox "File not saved. You must pick a different name and must use .xls file extension"
    End If
End If
End Sub

Select allOpen in new window

Brad

Brad,

The user doesn't need to pick a filename, I just want a specific path dialog box to open, and then the user can save the file with whatever name they want.  I would also like it to default to an xls format.

Thanks,
gdunn59

VBA offers Application.GetOpenFilename and Application.GetSaveAsFilename to return the path and filename that the user chooses (or enters) in a file browser dialog. These methods do not actually open or save the file, however. VBA also offers Application.Dialogs(xlDialogSaveAs) to display a file browser and actually save the file. Of these methods, I prefer to use Application.GetSaveAsFilename because it lets me specify the path.

If all you want is a filename without the file browser, then you can use InputBox:
Dim filename As String
filename = InputBox("Please enter the desired filename")
Using that value, you can use the previously suggested code to verify that it is different from the name of the template, carries a .xls extension and save the file to the desired path using that name.

Brad,

I do want the file browser to open with a specific path and then the user can type in the filename they desire and save as an xls format.

How can I do this?

The Saver macro that I posted works the way you describe. Is it not working that way on your computer?

Brad,

Sorry . . . I thought I had tried the Saver Macro, but apparently I didn't.

I just tried it and a Compatibility Checker Dialog Box comes up.  It says that the following features in this Workbook are not supported by earlier versions of Excel.  It says something about the formatting of the Pivot Tables.

Thanks,
gdunn59

Try changing the PivotTable version from 12 to 11 in your code.

Instead of this statement:

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion12

Select allOpen in new window

Try it this way:
 

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion11

Select allOpen in new window

Brad,

I tried your last posting, but still the same thing happens.  I am using Excel 2007.

Any other suggestions?

Thanks,
gdunn59

There were 10 places where you needed to change that string. Did you catch them all? I used the Edit...Replace menu item in the VBA Editor.

I tested the macros in Excel 2007 and 2003. The Saver macro displayed a warning message about PivotTables being in compact form and had to be converted to tabular, but the save proceeded.

Upon testing in Excel 2003, I found a runtime error caused by the TintAndShade statement in sub in ThisWorkbook. I deleted that statement as it wasn't doing anything.

I also found that the PivotChart dropdowns were missing in Excel 2003, and that changing the number of months made the data labels adopt a tacky looking fill color. But eerything still worked.

The attached workbook contains the fixes for PivotTableVersion12 and TintAndShade.

Brad
Quarterly-Assoc-Report-EE-Q28148.xlsm

Brad,

First, yes I did replace all of the strings, and secondly, I downloaded your latest spreadsheet, but still can't get it to work.

I did make the changes below, and it works (does not bring up the Compatibility Checker dialog box).  The only thing is when I go back to open the spreadsheet that I saved when prompted, I get the following message:

     The file that I am trying to open is in a different format than specified by the file extension . . .  Do you want to open the file?

When I answer Yes to opening the file, it opens and everything is fine.

I'm using the "xlPivotTableVersion12" in the Pivot Table code, and am using the "FileFormat:=xlExcel12" in the SaveAs code.

Below is the code that I am using:

Pivot Code:

         ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Audit Criteria", DefaultVersion _
        :=xlPivotTableVersion12

Select allOpen in new window

SaveAs Code:

Dim f As String, flPath As String, flName As String
flPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\Operational_Reports\"   'Path
f = Application.GetSaveAsFilename(flPath & "*.xls", FileFilter:="Excel files (*.xls),*.xls", _
    Title:="Choose the desired *.xls file name and location, then click 'Save'")
If f <> "False" Then
    i = InStrRev(f, Application.PathSeparator)
    flName = Mid(f, i + 1)
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
        iMod.Remove VBComponent:=iMod.Item("Module1")
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel12  'Save as .xls file
    Else
        MsgBox "File not saved. You must pick a different name and must use .xls file extension."
    End If
End If

Select allOpen in new window

Excel 2007 .xlsb file format is xlExcel12. Excel 2007 PivotTable is xlPivotTableVersion12.

Excel 97-2003 .xls file format is xlExcel8. Excel 2003 PivotTable is xlPivotTableVersion11.

You are getting the incompatible file format error message because you are saving the file with .xlsb file format but .xls extension.

If you use xlPivotTableVersion12 in the code, then there will be an incompatibility error when you save the file as .xls.

The file I posted works at my end using Excel 2007 and 2003. Please test it with the only modification being the path.

Brad,

I downloaded your last spreadsheet again, and only changed the path in the Saver Code, but when I run it, it doesn't even prompt for the SaveAs.  It just puts all the tabs in the Template and saves that with the original name of the Template.

What am I doing wrong?

Thanks,

gdunn59

I just downloaded the workbook I posted and opened it in Excel 2007. I then ran the macQtrlyAssocReport macro and then the Saver macro. The attached file is the result.

macQtrlyAssocReport creates the additional worksheets, PivotTables and PivotCharts. It does not save the file.

The Saver macro displays a file browser and allows me to type in a filename. If the filename is different from the template and has .xls file extension, then the save proceeds.
Quarterly-Assoc-Report-EE-Q28148.xls

I understand that the Saver macro displays a file browser, but it does not come up when running the code.

Do I need to place the Saver Code in a certain place in the Project Browser so it automatically prompts the user to save after it completes all the tabs in the spreadsheet?

Thanks,
gdunn59

In my posted workbook, macQtrlyAssocReport does not call Saver. You need to initiate both macros manually.

If it works to your satisfaction, then you can eliminate the need to call Saver by ending macQtrlyAssocReport like this:

Saver
End Sub

Select allOpen in new window

Brad,

I don't want the users to have to initiate anything manually.  Is there another way to go about this?

Actually, once I get everything working the way I want, I had planned on setting it up so as soon as the template opens, the macros run and creates everything automatically for the users.

Thanks,
gdunn59

You can use a Workbook_Open sub to automatically run the macQtrlyAssocReport and Saver macros when the workbook opens and macros are enabled. The Workbook_Open sub must go in the ThisWorkbook code pane, and won't work at all if installed anywhere else.

Private Sub Workbook_Open()
If Me.FileFormat = 52 Then      '.xlsm file format
    macQtrlyAssocReport
    Application.ScreenUpdating = True
    Saver
End If
End Sub

Select allOpen in new window

Brad,

Ok.  Thanks.

I need to work on a couple of other things right now, but when I get a minute I will try the last code you posted to run the 2 macros, and get back to you on my outcome.

Thanks so much for all your continued assistance.  Greatly appreciated!

gdunn59

Brad,

I downloaded again your spreadsheet from ID: 39240953, but I just can't get it to not bring up the Compatibility Checker.

All I did was download your spreadsheet referenced above, and changed the path location and then ran it.

What am I doing wrong?

Thanks,
gdunn59

Here is the code I'm using that is in your spreadsheet you posted:

Sub macQtrlyAssocReport()
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error Resume Next
    Set ws = Worksheets("Q1 Audit Criteria_Graph")
    On Error GoTo 0
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If


' Create Monthly Summary
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R35C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion11
    ActiveSheet.Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
        .Name = "Assoc Error"
    End With
'    Range("H2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Month")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
        .Name = "Audit Criteria Associate"
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Audit Criteria Associate")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Employee").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "", xlCount

    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error").CurrentPage = _
        "Y"
    ActiveSheet.PivotTables("Summary").PivotFields("Month").CurrentPage = _
        "(All)"
    ActiveSheet.PivotTables("Summary").PivotFields("Month"). _
        EnableMultiplePageItems = True

    ActiveSheet.PivotTables("Summary").ShowDrillIndicators = False

    Range("A7").Select
    Selection.Value = "Audit Criteria Associate"

    Range("A1:A4").Select
    Selection.Font.Bold = True

    Range("B1:B4").Select
    Selection.Font.Italic = True
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Summary"

' Create Quarterly Summary By Associate
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion11
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Assoc")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Assoc").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Assoc").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
'    Dim ws As Worksheet
'    Dim cel As Range, rg As Range
'    Dim i As Long
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data

' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
' Format certain Columns
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("A1:A2").Select
    Selection.Font.Bold = True

    Range("B1:B2").Select
    Selection.Font.Italic = True

' Move the Sheet to put in a particular order
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)

' Wrap Text in Column A
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select

' Rename the Active Sheet
    ActiveSheet.Name = "Q1 Summary by Associate"


' Create Quarterly Summary By Audit Criteria
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Audit Criteria", DefaultVersion _
        :=xlPivotTableVersion11
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A6").Select
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Criteria")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Audit Criteria").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data


' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("B1:B2").Select
    Selection.Font.Italic = True
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select
    ActiveSheet.Name = "Q1 Summary By Audit Criteria"

    
' Create Audit Criteria Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion11
        
   With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim cht As Chart
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
'    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 600
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    
' Create Associate Error Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion11).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Associate Error_Graph", DefaultVersion _
        :=xlPivotTableVersion11
        
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlColumnStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartArea.Interior.ColorIndex = 48
        .PlotArea.Interior.ColorIndex = 15
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Associate Error_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 8)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Associate Error_Graph"


' remove any sheets that are not named and are blank
Application.DisplayAlerts = False

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True

' Move focus back to Summary Sheet
Sheets("Summary").Select
Range("A8").Select

Application.EnableEvents = True

End Sub

Select allOpen in new window

Saver Code:

Sub Saver()
Dim f As String, flPath As String, flName As String
Dim i As Long
flPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\Operational_Reports\"   'Change to your desired path
f = Application.GetSaveAsFilename(flPath & "*.xls", FileFilter:="Excel files (*.xls),*.xls", _
    Title:="Choose the desired *.xls file name and location, then click 'Save'")
If f <> "False" Then
    i = InStrRev(f, Application.PathSeparator)
    flName = Mid(f, i + 1)
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel8   'Save as .xls file
    Else
        MsgBox "File not saved. You must pick a different name and must use .xls file extension"
    End If
End If
End Sub

Select allOpen in new window

I modified the code so the save proceeds without compatibility warning. Along with that, I eliminated all the .Select and .Activate statements that I could.
Quarterly-Assoc-Report-EE-Q28148.xlsm

Brad,

Ok.  Thanks.

Let me download your latest one, and give it a try.

I will let you know what happens.

Again, much appreciated!

gdunn59

Brad,

That seemed to work, it didn't bring up the Compatibility Checker.

One last thing that I have a concern about is removing the code from the new document.

I added the following code:

' Delete Module1 after it runs
Dim iMod As Object
Dim iBook As Workbook

Set iBook = ActiveWorkbook
Set iMod = iBook.VBProject.VBComponents

' Delete the module.
iMod.Remove VBComponent:=iMod.Item("Module1")

Select allOpen in new window

It seems to delete the code but if I close the new file and reopen again, the Module1 is back.  It did prompt me to save again before I closed the new document, but I answered "No" that I didn't want to save.

Where can I place the code above to delete the Module1 so that it automatically saves the document after the Module1 is deleted, without the user having to answer "Yes" to saving once they close the document?

The reason being, is unless the user actually makes a change themselves, they probably would not save the document when they exit, because they didn't actually make any changes.


Thanks,
gdunn59

If you have code that removes Module1, you have to save the workbook after running it. I'd suggest calling such a routine after running macInqryAssocReport and before Saver in the Workbook_Open sub. Note that you'll need to move the Saver sub to ThisWorkbook code pane if Module1 is being deleted.

Brad,

I just noticed also that somewhere during all the changes that some of the formatting of the tabs has been lost.  I have attached the Report and the way it should look.  It was formatting everything this way at some point.  I think up until today's changes.

For example:

Cell A7 on the Summary Tab should be "Audit Criteria Associate"
Cell A5 on the Q1 Summary By Audit Criteria Tab should be "Audit Criteria Associate"
Cell A5 on the Q1 Summary by Associate Tab should be "Audit Criteria Associate"
Cell A5 on the Q1 Audit Criteria_Graph Tab should be "Audit Criteria"
Cell A5 on the Q1 Associate Error_Graph Tab should be "Audit Criteria"

Also missing is just some of the general formatting that was on the original results (Bold, the blue shading).

See attached final Report results (how it should look)

Thanks,
gdunn59
Quarterly-Assoc-Report--Results-.xlsx

The problem is that you formatted the PivotTable in Excel 2007 and then want to get it to look like that in Excel 2003--which is missing some of the features of Excel 2007 PivotTables. I've tweaked the macro so the results are closer to your sample workbook, but there are still some differences.  See attached workbook.

That said, we are really getting quite far afield from the original question. I think you need to close this question and open a new one if you need further formatting changes. If you do so, please make sure that you reference this thread for context.

Brad
Quarterly-Assoc-Report-EE-Q28148.xlsm

Brad,

I understand we've gone quite far on this, but that is why I increased the points from the original 300 to 500.

I will try to get it to work.

Thanks,

gdunn59

Brad,

Can I at least ask what you did to keep the Compatibility Checker from coming up?

Thanks,
gdunn59

I noticed that the compatibility checker was complaining about the compact layout in three PivotTables: Summary, Q1 Summary by Audit Criteria and Q1 Summary by Associate. So I added the following statement to the end of the With blocks for those three PivotTables:
        .RowAxisLayout xlTabularRow

Tests showed that that one statement (three places) was sufficient to avoid the warnings in the compatibility checker.

With hindsight, it would have been better to develop this macro in Excel 2003 rather than Excel 2007. Approaching it that way would have minimized the formatting issues we are now trying to resolve.

FWIW, you'll find that while the active experts in the Excel Zone will all work on recorded macros in EE questions, we are much happier when they have been edited to eliminate the .Select and .Activate statements. Doing so makes the code much shorter and easier to understand. In other words, you'll get a better answer to your question if you post my latest version of the macro in a new question and state what it is that it doesn't do.

Try opening the workbook in Excel 2003 and record macros to change the formatting to what it needs to be. Then try to integrate the key statements in the macQtrlyAssocReport sub at the end of the With block for the relevant PivotTable.

Brad,

Thanks for all your assistance and valuable information.

I got everything to work the way I wanted it to.

Here is my final code:

Module1 Code:

Option Explicit
Sub macQtrlyAssocReport(Optional Str As String = "")
Dim ws As Worksheet
Dim i As Long
Dim cel As Range, rg As Range
Application.ScreenUpdating = False
Application.EnableEvents = False

' turn off compatibility checker
ActiveWorkbook.CheckCompatibility = False

On Error Resume Next
    Set ws = Worksheets("Q1 Audit Criteria_Graph")
    On Error GoTo 0
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If

' Create Monthly Summary
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R35C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveSheet.Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
        .Name = "Assoc Error"
    End With
'    Range("H2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Month")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
        .Name = "Audit Criteria Associate"
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Audit Criteria Associate")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With

    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Employee").Orientation = _
        xlHidden
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "", xlCount

    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc Error").CurrentPage = _
        "Y"
    ActiveSheet.PivotTables("Summary").PivotFields("Month").CurrentPage = _
        "(All)"
    ActiveSheet.PivotTables("Summary").PivotFields("Month"). _
        EnableMultiplePageItems = True

    ActiveSheet.PivotTables("Summary").ShowDrillIndicators = False

    Range("A7").Select
    Selection.Value = "Audit Criteria Associate"

    Range("A1:A4").Select
    Selection.Font.Bold = True

    Range("B1:B4").Select
    Selection.Font.Italic = True
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Summary"

' Create Quarterly Summary By Associate
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Assoc", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Assoc")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Assoc").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Assoc").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
'    Dim ws As Worksheet
'    Dim cel As Range, rg As Range
'    Dim i As Long
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data

' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
' Format certain Columns
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("A1:A2").Select
    Selection.Font.Bold = True

    Range("B1:B2").Select
    Selection.Font.Italic = True

' Move the Sheet to put in a particular order
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)

' Wrap Text in Column A
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select

' Rename the Active Sheet
    ActiveSheet.Name = "Q1 Summary by Associate"


' Create Quarterly Summary By Audit Criteria
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Summary By Audit Criteria", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A6").Select
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Criteria")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    End With
    
    Range("A5").Select
    With Selection
      .Value = "Audit Criteria Associate"
    End With
    
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum")
        .Orientation = xlRowField
        .Position = 3
    End With
    
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("InquiryNum").Orientation = _
        xlHidden
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").AddDataField ActiveSheet.PivotTables( _
        "Q1 Summary By Audit Criteria").PivotFields("InquiryNum"), "", xlCount
    With ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotFields("Quality_Review_Date")
        .Orientation = xlColumnField
        .Position = 1
    End With
    Range("B5").Select
    Selection.Group Start:=True, End:=True, Periods:=Array(False, False, False, _
        False, True, False, False)
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Audit Criteria").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data


' Put Borders around the Range selection from above
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Columns("A:A").Select
    Selection.ColumnWidth = 60
    
    Range("B1:B2").Select
    Selection.Font.Italic = True
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)
    
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Range("A6").Select
    ActiveSheet.Name = "Q1 Summary By Audit Criteria"

    
' Create Audit Criteria Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Audit Criteria_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
   With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    Dim cht As Chart
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlBarStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Audit Criteria_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
'    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 600
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"
    
    
' Create Associate Error Chart
    Sheets.Add
    ActiveSheet.Select
    Cells(3, 1).Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R278C8", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Q1 Associate Error_Graph", DefaultVersion _
        :=xlPivotTableVersion12
        
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Font.Bold = True

    Columns("A:A").ColumnWidth = 60

    Range("B1:B2").Font.Italic = True

    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)
    Set cel = rg.Cells(1, rg.Columns.Count)
    Set cel = rg.Cells(rg.Rows.Count, 1)
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)
    
    ActiveSheet.Shapes.AddChart
    With ActiveSheet.ChartObjects(1).Chart
        .SetSourceData Source:=rg
        .ChartType = xlColumnStacked
        .ChartStyle = 2
        .ClearToMatchStyle
        .ApplyLayout (2)
        .ChartArea.Interior.ColorIndex = 48
        .PlotArea.Interior.ColorIndex = 15
        .ChartTitle.Text = "Audit Criteria Errors"
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .Orientation = xlColumnField
        .Position = 1
    End With
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 1
    End With
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").AddDataField ActiveSheet.PivotTables( _
        "Q1 Associate Error_Graph").PivotFields("InquiryNum"), "Count of InquiryNum", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    
    With ActiveSheet.PivotTables("Q1 Associate Error_Graph").PivotFields("Month")
        .PivotItems("April").Visible = False
        .PivotItems("May").Visible = False
        .PivotItems("June").Visible = False
        .PivotItems("July").Visible = False
        .PivotItems("August").Visible = False
        .PivotItems("September").Visible = False
        .PivotItems("October").Visible = False
        .PivotItems("November").Visible = False
        .PivotItems("December").Visible = False
    End With
    
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    ActiveSheet.PivotTables("Q1 Associate Error_Graph").CompactLayoutColumnHeader = " "
    Cells.EntireColumn.AutoFit
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 8)

    With Columns("A:A")
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Set ws = ActiveSheet
    i = ws.UsedRange.Rows.Count     'This statement is sometimes needed to reset the UsedRange property
    Set rg = ws.UsedRange
    Set cel = rg.Cells(1, 1)       'First row and column that contain data
    Set cel = rg.Cells(1, rg.Columns.Count)        'First row, last column that contains data
    Set cel = rg.Cells(rg.Rows.Count, 1)             'First column, last row that contains data
    Set cel = rg.Cells(rg.Rows.Count, rg.Columns.Count)        'Last row, last column that contains data
        
    With rg.Borders
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
                                  
    With ActiveSheet.ChartObjects(1)
        .Left = rg.Cells(5, rg.Columns.Count + 2).Left
        .Top = rg.Cells(5, 1).Top
        .Height = 270
        .Width = 600
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Associate Error_Graph"


' remove any sheets that are not named and are blank
Application.DisplayAlerts = False

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True


' Move focus back to Summary Sheet
Sheets("Summary").Select
Range("A8").Select

Application.EnableEvents = True

End Sub

Select allOpen in new window

ThisWorkBook Code:

Option Explicit

Private Sub Workbook_Open()
If Me.FileFormat = 52 Then      '.xlsm file format
    macQtrlyAssocReport
    Application.ScreenUpdating = True
    Saver
End If
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim rg As Range
Dim obj As Object
If (Sh.PivotTables.Count = 1) And (Sh.ChartObjects.Count = 1) Then
    Set rg = Sh.PivotTables(1).TableRange2
    If Not Intersect(rg, Target) Is Nothing Then
        Application.EnableEvents = False
        Sh.ChartObjects(1).Left = rg.Cells(5, rg.Columns.Count + 2).Left
        Set obj = Selection
        Sh.Cells(1, 1).Select
        With Sh.Cells.Borders
            .LineStyle = xlNone
        End With
        Cells.Borders.LineStyle = xlLineStyleNone
        With rg.Borders
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        obj.Select
        Application.EnableEvents = True
    End If
End If
End Sub


Sub Saver(Optional Str As String = "")
' Save Workbook
Dim f As String, flPath As String, flName As String, i As Variant
flPath = "\\Wiw2pwpfle001\data\QA Database\Employee Audit Scorecard System\Reports\Operational_Reports\"   'Path
f = Application.GetSaveAsFilename(flPath & "*.xls", FileFilter:="Excel files (*.xls),*.xls", _
    Title:="Choose the desired *.xls file name and location, then click 'Save'")
If f <> "False" Then
    i = InStrRev(f, Application.PathSeparator)
    flName = Mid(f, i + 1)
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel12  'Save as .xls file
    Else
        MsgBox "File not saved. You must pick a different name and must use .xls file extension."
    End If
End If
End Sub

Select allOpen in new window

I got 10 compatibility errors in Excel 2007 with your "final" code when saving as .xls file format. Was this not happening at your end?

Brad

Brad,

Nope sure didn't.  The only thing I get is if I close the document and then go back to open I get the message about it being in a different format, and do I still want to open.  I answer Yes and everything is fine.

Thanks,
gdunn59

You didn't see any compatibility error messages because you were saving the file in .xlsb file format. I saw those compatibility error messages because I was saving the file in .xls file format.

I believe you were testing with Excel 2007, which will graciously open the file after it has been saved in .xlsb format with a .xls file extension. Even so, you must respond "Yes" to the warning message that the file is in a different format than the extension.

I assume that you wanted to use .xls file format because some users still run Excel 2003. Be aware that they will get an unrecognizable file format error message when they try to open the file. Even if they have installed the Office 2007 file compatibility pack, they still won't be able to open the file successfully until they change the file extension in Windows Explorer (file browser) to .xlsb.

Brad

I changed the line of code in my Saver sub to what byundt suggested and this seemed to work.

I just added the application.display alerts (True/False) to the beginning and ending code.

Thanks,
gdunn59