Solved

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

Posted on 2013-06-05
54
680 Views
Last Modified: 2013-07-02
I have VBA Code that creates a Pivot Chart.  Part of the code moves the Chart once it is completed, to a specific location in the spreadsheet.  The problem I'm having is if the filter of the data has more data sometimes than other times, it doesn't adjust for the extra data, and places the Chart on top of some of the Pivot Table data.  This would also be an issue if there is less data.

The row will always be the same (Row 5).  What I need it to do is find the last column (of Row 5) where there is data, and then move over 1 column and then place the Chart there.

In the Code, Lines 67-77 it is filtering the data so that it only shows data for Jan, Feb & Mar, but if the data is filtered for more months, i.e. Jan, Feb, Mar, Apr, May, and Jun, then the Chart's starting point is still Cell G5 so it overlaps the Pivot Table, so it needs to be able to adjust based off the data.

The following Code below, which is Lines 100-106 of the code, is what places the Pivot Chart in the sheet on Row 5:

ActiveSheet.ChartObjects("Chart 1").Activate
    With ActiveChart.Parent
        .Left = 500
        .Top = 60
        .Height = 600
        .Width = 600
    End With


Entire Code that creates the Pivot Chart:

' 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
    
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A1:A2").Select
    Selection.Font.Bold = True

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

    Range("B1:B2").Select
    Selection.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) 
    
    Cells(1, 1).Select
    Range("G5").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=rg
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.ChartType = xlBarStacked
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 2
    ActiveChart.ClearToMatchStyle
    ActiveChart.ApplyLayout (2)
    
    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
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveChart.ChartTitle.Select
    ActiveWorkbook.ShowPivotChartActiveFields = False
    ActiveChart.ChartTitle.Text = "Audit Criteria Errors"
    
    Range("A3").Select
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").DataPivotField.PivotItems( _
        "Count of InquiryNum").Caption = " "
        
    Range("A4").Select
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutRowHeader = _
        "Audit Criteria"
        
    Range("B3").Select
    ActiveSheet.PivotTables("Q1 Audit Criteria_Graph").CompactLayoutColumnHeader = " "
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.Select
                
    ActiveSheet.ChartObjects("Chart 1").Activate
    With ActiveChart.Parent
        .Left = 500
        .Top = 60
        .Height = 600
        .Width = 600
    End With
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 6)

    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
    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(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With rg.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With rg.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With rg.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With rg.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With rg.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

    ActiveSheet.Range("A6").Select
    ActiveSheet.Name = "Q1 Audit Criteria_Graph"

Open in new window


Also need to know how to change the back color of the Chart and Plot Areas with VBA Code.

Thanks,
gdunn59
0
Comment
Question by:gdunn59
  • 29
  • 24
54 Comments
 
LVL 80

Expert Comment

by:byundt
ID: 39228789
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

Open in new window

0
 

Author Comment

by:gdunn59
ID: 39229677
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

Open 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

Open in new window


Thanks,
gdunn59
0
 
LVL 80

Expert Comment

by:byundt
ID: 39230066
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

Open 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

Open in new window

Brad
0
 
LVL 80

Expert Comment

by:byundt
ID: 39230087
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
0
 

Author Comment

by:gdunn59
ID: 39230277
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39230291
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.
0
 

Author Comment

by:gdunn59
ID: 39230322
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
0
 

Author Comment

by:gdunn59
ID: 39230437
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
0
 

Author Comment

by:gdunn59
ID: 39230560
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

Open 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

Open in new window



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

Thanks,

gdunn59
0
 
LVL 80

Expert Comment

by:byundt
ID: 39230669
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

Open in new window


You do this:
    Range("A5").Value = "Audit Criteria Associate"

Open in new window

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

Brad
0
 

Author Comment

by:gdunn59
ID: 39230689
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
0
 
LVL 80

Expert Comment

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

Brad
0
 

Author Comment

by:gdunn59
ID: 39231151
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39231666
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

Open 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

Open 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
0
 

Author Comment

by:gdunn59
ID: 39231923
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39231992
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

Open in new window

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

Author Comment

by:gdunn59
ID: 39236121
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
0
 

Author Comment

by:gdunn59
ID: 39236178
Oops, forgot to increase the points.

Thanks,
gdunn59
0
 
LVL 80

Expert Comment

by:byundt
ID: 39236333
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

Open in new window

Brad
0
 

Author Comment

by:gdunn59
ID: 39238078
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39239108
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.
0
 

Author Comment

by:gdunn59
ID: 39239752
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?
0
 
LVL 80

Expert Comment

by:byundt
ID: 39239788
The Saver macro that I posted works the way you describe. Is it not working that way on your computer?
0
 

Author Comment

by:gdunn59
ID: 39239855
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39239871
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

Open 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

Open in new window

0
 

Author Comment

by:gdunn59
ID: 39240066
Brad,

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

Any other suggestions?

Thanks,
gdunn59
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 80

Expert Comment

by:byundt
ID: 39240953
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
0
 

Author Comment

by:gdunn59
ID: 39241803
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

Open 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

Open in new window

0
 
LVL 80

Expert Comment

by:byundt
ID: 39241837
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.
0
 

Author Comment

by:gdunn59
ID: 39241872
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39242002
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
0
 

Author Comment

by:gdunn59
ID: 39242019
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39242039
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

Open in new window

0
 

Author Comment

by:gdunn59
ID: 39242086
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39242351
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

Open in new window

0
 

Author Comment

by:gdunn59
ID: 39242379
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
0
 

Author Comment

by:gdunn59
ID: 39242526
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
0
 

Author Comment

by:gdunn59
ID: 39242729
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

Open 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

Open in new window

0
 
LVL 80

Expert Comment

by:byundt
ID: 39242763
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
0
 

Author Comment

by:gdunn59
ID: 39242823
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
0
 

Author Comment

by:gdunn59
ID: 39242876
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")

Open 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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39242901
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.
0
 

Author Comment

by:gdunn59
ID: 39242918
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
0
 
LVL 80

Expert Comment

by:byundt
ID: 39243134
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
0
 

Author Comment

by:gdunn59
ID: 39243216
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
0
 

Author Comment

by:gdunn59
ID: 39243219
Brad,

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

Thanks,
gdunn59
0
 
LVL 80

Expert Comment

by:byundt
ID: 39243251
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.
0
 

Author Comment

by:gdunn59
ID: 39243279
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

Open 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

Open in new window

0
 
LVL 80

Expert Comment

by:byundt
ID: 39243325
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
0
 

Author Comment

by:gdunn59
ID: 39248429
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
0
 
LVL 80

Accepted Solution

by:
byundt earned 500 total points
ID: 39248449
The different format message when the file reopens occurs because your Saver sub uses xlExcel12 instead of xlExcel8 in this statement:
    If (LCase(Right(flName, 4)) = ".xls") And (flName <> ActiveWorkbook.Name) Then
        ActiveWorkbook.SaveAs flPath & flName, FileFormat:=xlExcel12  'Save as .xls file

xlExcel12 is the .xlsb file format. xlExcel8 is the .xls file format.
0
 
LVL 80

Expert Comment

by:byundt
ID: 39249121
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
0
 

Author Closing Comment

by:gdunn59
ID: 39294889
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
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

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

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

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now