?
Solved

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

Posted on 2013-05-23
8
Medium Priority
?
726 Views
Last Modified: 2013-06-08
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
Comment
Question by:gdunn59
  • 6
  • 2
8 Comments
 
LVL 39

Assisted Solution

by:nutsch
nutsch earned 900 total points
ID: 39192514
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
 
LVL 1

Accepted Solution

by:
gdunn59 earned 0 total points
ID: 39206182
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
 
LVL 1

Author Comment

by:gdunn59
ID: 39208853
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
Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

 
LVL 39

Expert Comment

by:nutsch
ID: 39208896
Remove sheets.add on line 94.
0
 
LVL 1

Author Comment

by:gdunn59
ID: 39208915
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
 
LVL 1

Assisted Solution

by:gdunn59
gdunn59 earned 0 total points
ID: 39211634
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
 
LVL 1

Assisted Solution

by:gdunn59
gdunn59 earned 0 total points
ID: 39217270
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
 
LVL 1

Author Closing Comment

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

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

840 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