• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 733
  • Last Modified:

Why is my Pivot Table VBA Code creating more than 1 Sheet/Pivot Table

I have written VBA code (macro) in Excel that creates a Pivot Table, it seems to be working the only problem is that it creates 2 sheets.  The first one is blank, and the second one contains the Pivot Table that I want.

Also, every time I run the code/macro it increases the Sheet Number.  I want the final Sheet that contains the Pivot Table to be named "Summary".

I have included the Code/Macro.

What is wrong?

Thanks,

gdunn59


Sub macQtrlyAssocReport()
' macQtrlyAssocReport Macro
' Create Pivot Table

    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R270C7", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveSheet.Select
    Cells(3, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "Associate Errors", xlCount
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 2
    End With
    Range("A2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc").CurrentPage = _
        "Y"
    ActiveWorkbook.ShowPivotTableFieldList = False

End Sub

Open in new window

0
gdunn59
Asked:
gdunn59
  • 6
  • 2
4 Solutions
 
nutschCommented:
Since there's no table destination in your pivot creation, it creates a new sheet automatically. I address the naming part at the end of the code.

Try this version

Sub macQtrlyAssocReport()
' macQtrlyAssocReport Macro
' Create Pivot Table

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Detail!R1C1:R270C7", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="", TableName:="Summary", DefaultVersion _
        :=xlPivotTableVersion12
    ActiveSheet.Select
    Cells(3, 1).Select
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("Summary")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields( _
        "Quality_Review_Criteria")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Employee")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("Summary").AddDataField ActiveSheet.PivotTables( _
        "Summary").PivotFields("InquiryNum"), "Associate Errors", xlCount
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc Ops Area")
        .Orientation = xlPageField
        .Position = 2
    End With
    Range("A2").Select
    With ActiveSheet.PivotTables("Summary").PivotFields("Manager_Name")
        .Orientation = xlPageField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Summary").PivotFields("Assoc")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc"). _
    EnableMultiplePageItems = True
    ActiveSheet.PivotTables("Summary").PivotFields("Assoc").CurrentPage = _
        "Y"
    ActiveWorkbook.ShowPivotTableFieldList = False

on error resume next
activesheet.name="Summary"
if err<>0 then msgbox("There's already a sheet called Summary")

End Sub

Open in new window

0
 
gdunn59Author Commented:
nutsch:

Your solution seemed to work, but the user that I am creating this for just informed me that they need more than one sheet added to the workbook.  

Now, since I added the 2nd sheet/pivot table again it is creating a blank tab beween the other 2 tabs.

Also the other issue is on the "Q1 Summary By Assoc" tab, where I am formatting the pivot table and adding borders (starting at line 165 of the code through line 205), although I am only selecting the actual portion of the pivot table that has data, it is adding borders to the entire sheet starting at cell A6.

Here is the full Code (which includes the previous code posted for the initial sheet, and the new sheet that was added):

Sub macQtrlyAssocReport()
'macQtrlyAssocReport Macro

Dim MonthSheet As String

MonthSheet = Sheets("Detail").Range("H2")

    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
'        .Font.Italic = True
    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
'        "Summary").PivotFields("InquiryNum"), "Count of 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
    
'On Error Resume Next
ActiveSheet.Name = "Summary"
Range("A6").Select

''ActiveSheet.Name = MonthSheet & " " & "Summary"
'If Err <> 0 Then MsgBox ("There's already a sheet called Summary")


'' Create Quarterly Summary Sheet
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    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
'    ActiveSheet.Select
'    Cells(3, 1).Select
    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
    Range("A6").Select
    With ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotFields("Employee")
        .LayoutForm = xlOutline
        .LayoutCompactRow = True
    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"), "Count of 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)
    Columns("A:A").ColumnWidth = 59.29
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", _
        xlLabelOnly + xlFirstRow, True
    Columns("A:A").ColumnWidth = 49
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    'Range("A1").Select
    
    Range("A6").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
'    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
'    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A6").Select

On Error Resume Next
ActiveSheet.Name = "Q1 Summary By Assoc"
'ActiveSheet.Name = MonthSheet & " " & "Summary"
If Err <> 0 Then MsgBox ("There's already a sheet called Q1 Summary By Assoc")

End Sub

Open in new window


I've changed the points from 300 to 500.

Thanks,
gdunn59
0
 
gdunn59Author Commented:
Ok.  Since my last posting everything appears to be working okay with the exception of the issue with the extra tab being inserted in between the "Summary" and "Q1 Summary By Assoc" (see the latest code below).

Here is the latest code:

Sub macQtrlyAssocReport()
'macQtrlyAssocReport Macro

Dim MonthSheet As String

MonthSheet = Sheets("Detail").Range("H2")

    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
'        .Font.Italic = True
    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
'        "Summary").PivotFields("InquiryNum"), "Count of 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
    
'On Error Resume Next
ActiveSheet.Name = "Summary"
Range("A6").Select

''ActiveSheet.Name = MonthSheet & " " & "Summary"
'If Err <> 0 Then MsgBox ("There's already a sheet called Summary")


'' Create Quarterly Summary Sheet
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    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
'    ActiveSheet.Select
'    Cells(3, 1).Select
    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
'        .Name = "Audit Criteria Associate"
    End With
    Range("A6").Select
    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)
    Columns("A:A").ColumnWidth = 59.29
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    Columns("A:A").ColumnWidth = 49
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    'Range("A1").Select
    
    Range("A6").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Range("A1:A2").Select
    Selection.Font.Bold = True
    
    Range("A6").Select

On Error Resume Next
ActiveSheet.Name = "Q1 Summary By Assoc"
'ActiveSheet.Name = MonthSheet & " " & "Summary"
If Err <> 0 Then MsgBox ("There's already a sheet called Q1 Summary By Assoc")

End Sub

Open in new window


Can you please assist me with the issue of it inserting the extra blank tab?

Thanks,

gdunn59
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
nutschCommented:
Remove sheets.add on line 94.
0
 
gdunn59Author Commented:
nutsch:

When I remove sheets.add on line 94, I then get the following error:

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


Thanks,
gdunn59
0
 
gdunn59Author Commented:
Since I haven't heard back from anyone on the issue of the code placing extra blank sheets/tabs in the workbook, I went ahead and wrote an IF Statement to remove any Sheets that have not been renamed from "Sheet...". to something else.

Since in the code I am renaming all the sheets, this code is doing exactly what I need it to do.

Here is the code (inserted at the very end):

' remove any sheets that are not named and are blank
Dim ws As Worksheet
Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True

Sheets("Summary").Select
Range("A1").Select

Open in new window



I also entered more code to create another sheet/tab.  Here is the entire code:

Sub macQtrlyAssocReport()
'macQtrlyAssocReport Macro

Dim MonthSheet As String

MonthSheet = Sheets("Detail").Range("H2")

' 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
'        .Font.Italic = True
    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
'        "Summary").PivotFields("InquiryNum"), "Count of 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
    
'On Error Resume Next
ActiveSheet.Name = "Summary"
'ActiveSheet.Name = MonthSheet & " " & "Summary"
'If Err <> 0 Then MsgBox ("There's already a sheet called Summary.")
ActiveSheet.Range("A6").Select

''ActiveSheet.Name = MonthSheet & " " & "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
    Range("A6").Select
    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)
    Columns("A:A").ColumnWidth = 59.29
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    Range("A2").Select
    Columns("A:A").ColumnWidth = 52.14
    Range("A6").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").ShowDrillIndicators = False
    ActiveSheet.PivotTables("Q1 Summary By Assoc").PivotSelect "Employee[All]", xlLabelOnly + xlFirstRow, True
    Columns("A:A").ColumnWidth = 49
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B4").Select
    ActiveSheet.PivotTables("Q1 Summary By Assoc").CompactLayoutColumnHeader = ""
    Range("B6").Select
    Columns("B:B").EntireColumn.AutoFit
    
    Range("A6").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .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("A1:A2").Select
    Selection.Font.Bold = True

    Range("B1:B2").Select
    Selection.Font.Italic = True
    
    ActiveSheet.Move Sheets(Sheets("Summary").Index + 1)
    
    Range("A6").Select

On Error Resume Next
ActiveSheet.Name = "Q1 Summary By Assoc"
'ActiveSheet.Name = MonthSheet & " " & "Summary"
If Err <> 0 Then MsgBox ("There's already a sheet by that name")


'
'' 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
'        .Name = "Audit Criteria Associate"
    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)
    Columns("A:A").ColumnWidth = 59.29
    Cells.Select
    Cells.EntireColumn.AutoFit
    Selection.ColumnWidth = 55.71
    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
    Columns("A:A").ColumnWidth = 49
    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
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Range(Selection, Selection.End(xlUp)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .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("Detail").Index + 3)
    
    Range("A6").Select

On Error Resume Next
ActiveSheet.Name = "Q1 Summary By Audit Criteria"
'ActiveSheet.Name = MonthSheet & " " & "Summary"
If Err <> 0 Then MsgBox ("There's already a sheet by that name")


' remove any sheets that are not named and are blank
Dim ws As Worksheet
Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name Like "Sheet*" Then
            ws.Delete
        End If
    Next ws

Application.DisplayAlerts = True

Sheets("Summary").Select
Range("A1").Select

End Sub

Open in new window



The only thing I am still having issues with is the borders.  Can anyone assist with this?

Thanks,
gdunn59
0
 
gdunn59Author Commented:
I never received any solutions for the issue I was still having with the borders, but I was able to figure it out.

Below is the code I wrote that fixed the border issue I was having:

    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
    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)
    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

Open in new window

0
 
gdunn59Author Commented:
I would like the points changed back to 300 since I offered to up the points to 500 if Expert nutsch could assist me in figuring out the other 2 issues that I was having with the extra  blank tabs/sheets being inserted, and the issue with the borders.

So the points that should be awarded to Expert nutsch is the original 300 points.

Thanks,
gdunn59
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

  • 6
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now