Link to home
Create AccountLog in
Avatar of gdunn59
gdunn59

asked on

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

SOLUTION
Avatar of nutsch
nutsch
Flag of United States of America image

Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
ASKER CERTIFIED SOLUTION
Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
Avatar of gdunn59
gdunn59

ASKER

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
Remove sheets.add on line 94.
Avatar of gdunn59

ASKER

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
SOLUTION
Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
SOLUTION
Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
Avatar of gdunn59

ASKER

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