Please help change my code!! VBA Code to generate pivot table and charts on a seperate sheet

Dremzy

New Member
Joined
Apr 19, 2014
Messages
29
Hi Guys,

Would someone be kind enough to change my code so that the sheet the pivot tables are created in has a specific name (make it whatever you want). Through the rest of the code it should then reference back to this name. The reason I want to do this is due to the fact that my code below doesn't allow me to then take the charts created and move them to another sheet. If I want to come back to the sheet that has the charts with VBA I can't because the sheet doesn't have any unique name, it simply becomes "Sheet 1" or "Sheet 2" .

Here is the code.

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
 
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

Forum statistics

Threads
1,216,000
Messages
6,128,202
Members
449,433
Latest member
mwegter95

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top