Help with my VBA code: How to specify the name of the sheet pivot table is created in

[Dremzy]

Hi guys,

The following code I created, makes a pivot table in a new sheet and then performs some other functions to create charts from the data.

Is there a way to change this code so that the sheet where I create this pivot table is given a specific unique name. At the current time it does a sheet count, so every time I run the macro the pivot table is created on sheet 1, sheet 2 etc.

The issue with this is at the end of this macro I would like to copy and paste a picture from another sheet into the sheet with the pivot table, but if it doesn't have a unique reference I cannot create a code for that command.

here is the code:

Sub CreatePivotTableandchart()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
'Determine the data range you want to pivot
SrcData = ActiveSheet.Name & "!" & Range("A1:F200").Address(ReferenceStyle:=xlR1C1)
'Create a new worksheet
Set sht = Sheets.Add
'Where do you want Pivot Table to start?
StartPvt = sht.Name & "!" & sht.Range("A2").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")

ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Category "), "Count of Category ", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Category ")
                .Orientation = xlRowField
        .Position = 1
End With
Set shtPTable = ActiveSheet
Range("A4:B11").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPie
Application.EnableEvents = False
With ActiveSheet.PivotTables("PivotTable1")
ActiveChart.ShowAllFieldButtons = False
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.ShowCategoryName = False
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = "Category of query received into mailbox:"
Selection.Format.TextFrame2.TextRange.Characters.Text = "Category of query received into mailbox:"
Selection.Position = xlLabelPositionOutsideEnd
End With
With Selection.Format.TextFrame2.TextRange.Characters(1, 15).ParagraphFormat
.TextDirection = msoTextDirectionLeftToRight
.Alignment = msoAlignCenter
End With
With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 32, 96)
        .Transparency = 0
        .Solid
    End With
    With Selection.Format.TextFrame2.TextRange.Font
        .NameComplexScript = "Arial"
        .NameFarEast = "Arial"
        .Name = "Arial"
    End With
    Selection.Format.TextFrame2.TextRange.Font.Size = 14
ActiveChart.SeriesCollection(1).Points(1).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 36, 105)
.Transparency = 0
.Solid
End With
ActiveChart.SeriesCollection(1).Points(2).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(158, 162, 162)
.Transparency = 0
.Solid
End With
ActiveChart.SeriesCollection(1).Points(3).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(205, 0, 88)
.Transparency = 0
.Solid
End With
ActiveChart.SeriesCollection(1).Points(5).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 169, 206)
.Transparency = 0
.Solid
End With
ActiveChart.SeriesCollection(1).Points(6).Select
With Selection.Format.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(240, 179, 35)
.Transparency = 0
.Solid
End With
With ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Position = xlLabelPositionOutsideEnd
End With
Range("A1").Select
ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Legend.Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
    Range("M14").Select
    ActiveSheet.Pictures.Paste.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Delete

Range("A5").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of Category "). _
        Orientation = xlHidden
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Time taken to respond" _
)
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Time taken to respond"), _
        "Count of Time taken to respond", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Time taken to respond" _
        )
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Category ").Orientation = _
        xlHidden
Set shtPTable = ActiveSheet
Range("A4:B11").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.HasTitle = True
    
    ' Formatting
    ActiveChart.ChartTitle.Text = " Average response time to mailbox query:"
    ActiveChart.ChartTitle.Font.Size = 10
    ActiveChart.SetSourceData Source:=Range("$A$2:$B$6")
    ActiveChart.ApplyLayout (1)
    ActiveChart.ShowAllFieldButtons = False
    ActiveChart.SeriesCollection(1).Interior.Color = RGB(0, 36, 105)
    ActiveChart.ChartTitle.Font.Color = RGB(0, 36, 105)
    ActiveChart.HasLegend = False
    With ActiveChart.Axes(xlValue).TickLabels.Font
        .Size = 10
        .Name = "Arial"
        .Color = RGB(0, 36, 105)
    End With
    With ActiveChart.Axes(xlCategory).TickLabels.Font
        .Size = 10
        .Name = "Arial"
        .Color = RGB(0, 36, 105)
    End With
  
    ActiveChart.ChartArea.Select
    ActiveChart.ChartArea.Copy
    Range("M33").Select
    ActiveSheet.Pictures.Paste.Select
    Range("M13:T51").Select
    Application.CutCopyMode = False
    Selection.Cut
    Range("D8").Select
    ActiveSheet.Paste
ActiveSheet.ChartObjects(1).Activate
ActiveSheet.ChartObjects(1).Delete
Application.ScreenUpdating = True
Application.EnableEvents = True

 

[Aaron Blood]

Generally, I use syntax like this...

Sub AddNewSheet()
    With Sheets.Add
        .Name = "MaPivotSheet"
    End With
End Sub

...if I want to specify a name for a sheet that is added in code.

 

[Dremzy]

When I try to put that code into my code above it doesn't work.

Are you able to add this within my code above please?? I want the rest of the code to then reference this sheet as the location for the pivots, instead of what it is saying now.

 

[Aaron Blood]

For this section in your code:

'Create a new worksheet
Set sht = Sheets.Add

Replace it with this:

'Create a new worksheet
Dim n As String
n = "MaPivotSheet"
With Sheets.Add
    .Name = n
End With
Set sht = Sheets(n)