Macro to add Pivot Charts to a workbook

[zookeepertx]

I'm going to tear my hair out!!! I'm trying to figure out how to get a macro to add Pivot Charts to a workbook and am soon going to wind up in a padded room! I've tried recording a macro doing exactly what I need, but the macro won't work when I try to run it. I've googled all over God's green earth and have tried at least 4 codes that I found there but nothing works. I've tried piecing together code using some/all of the above and NOTHING WORKS!!

Well, actually, I did have one bit of it working on a very small, very basic example of data, but then, when I tried to make it work on some data just a BIT larger than that, it failed again. Now, I've messed with ALL of the attempts so badly that I can't make sense of any of them.
I've been working on this for almost 2 days!!

Ultimately, each of the sections of data - separated by "Method" needs to have it's own Pivot Table and Pivot Chart, all on one sheet in the workbook, one below another.

I'm attaching a shortened version of what I'm working with. The first tab is how the data gets here in the very first place. The Results tab is what the coding I've already made does with it (before arriving at the pivot table part). The second "results" is the one I've been using to work on the Pivot Chart Macro. "Pivot Tables" shows what I want to end up with (just using the top 2 sections for an example.) The Pivot Tables need to be grouped by column P - "Method", then by E - "Out of Range". The data consists of Tracking# - First a Count, Second a % of the Grand Total.

Just to be thorough, here is the coding I made to get from the very original data to the Results tabs:

Sub WebDeliveryDate()
'Jenny 06052015
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

LR = Range("A" & Rows.count).End(xlUp).row
Range("A" & "2" & ":S" & LR).Select
    Selection.Sort Key1:=Range("P1"), Order1:=xlAscending

For i = LR To 2 Step -1
    If Range("P" & i).Value = "APP" Then
        Range("P" & i).Value = "USPS"
    ElseIf Range("P" & i).Value = "DD" Then
        Range("P" & i).Value = "2 Day"
    ElseIf Range("P" & i).Value = "FEDXG" Then
        Range("P" & i).Value = "Ground"
    ElseIf Range("P" & i).Value = "FEDXH" Then
        Range("P" & i).Value = "Home Delivery"
    ElseIf Range("P" & i).Value = "ON" Then
        Range("P" & i).Value = "Overnight"
    Else
        Rows(i & ":" & i).EntireRow.Delete
    End If
Next i

For LR = Cells(Cells.Rows.count, "P").End(xlUp).row To 3 Step -1
     If Cells(LR, "P") <> Cells(LR - 1, "P") Then
         Rows(LR).EntireRow.Insert
     End If
Next LR

FS = Columns("P").Find(What:=Range("P3").Value, SearchDirection:=xlPrevious).row
SS = Columns("P").Find(What:=Range("P" & FS + 2), SearchDirection:=xlPrevious).row
TS = Columns("P").Find(What:=Range("P" & SS + 2), SearchDirection:=xlPrevious).row
FS2 = Columns("P").Find(What:=Range("P" & TS + 2), SearchDirection:=xlPrevious).row

With Range("A1:S1")
    .Copy Range("A" & (FS + 1) & ":S" & (FS + 1) & ",A" & (SS + 1) & ":S" & (SS + 1) & _
    ",A" & (TS + 1) & ":S" & (TS + 1) & ",A" & (FS2 + 1) & ":S" & (FS2 + 1))
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Here is one of the versions of code that I tried to adapt from one I found online.

Sub CreatePivotTable()
Dim mysheet As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim pf3 As PivotField
Dim pf4 As PivotField
mydata = Range("A1:S6")
    Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, mydata)
    Set pt = pc.CreatePivotTable(Range("A40"), "ItemList")
    Set pf1 = pt.PivotFields("Methdo")
        pf1.Orientation = xlRowField
    Set pf2 = pt.PivotFields("Out of Range")
        pf2.Orientation = xlRowField
    Set pf3 = pt.PivotFields("Tracking#")
        pf3.Orientation = xlDataField
    Set pf4 = pt.PivotFields("Tracking#")
        pf4.Orientation = xlDataField
        pf4.Caption = "% of Method"
        pf4.Calculation = xlPercentOfTotal
        pf4.NumberFormat = "0.00%"
    CreatePivotChart
End Sub
Sub CreatePivotChart()
Dim chobj As ChartObject
Dim ch As Chart
Set mycheet = Sheets("Result(2)")
Set chobj = mycheet.ChartObjects.Add(300, 500, 300, 150)
Set chobj = chobj.Chart
ch.SetSourceData pt.TableRange1
cl.ChartType = xlColumnClustered
chobj.Name = "EChart1"
End Sub

Here's something else I've tried

Sub TestPivot()
' TestPivot Macro
    Range("A1:S37").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "L29391_289 (5)!R1C1:R37C19", Version:=xlPivotTableVersion14). _
        CreatePivotTable TableDestination:="Sheet8!R1C1", TableName:="PivotTable2" _
        , DefaultVersion:=xlPivotTableVersion14
    Sheets("Sheet8").Select
    Cells(1, 1).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Sheet8!$A$1:$C$18")
    ActiveSheet.Shapes("Chart 1").IncrementLeft 192
    ActiveSheet.Shapes("Chart 1").IncrementTop 15
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Method")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("OutOfRange")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Tracking#"), "Count of Tracking#", xlCount
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("Tracking#"), "Count of Tracking#2", xlCount
    ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of Tracking#"). _
        Caption = "Count"
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Count of Tracking#2")
        .Caption = "% of Method"
        .Calculation = xlPercentOfTotal
        .NumberFormat = "0.00%"
    End With
End Sub

I assume nobody wants to slog through the other 5 versions of the code that I have at this point, so I'll save you looking at them.

I'm getting seriously furious with this!! PLEASE can someone help me?

EDITED: Okay, I forgot to attach my workbook to my post and now it won't let me attach via "Edit Post" or "Reply". Why does it hate me??

Jenny

 

[V_Malkoti]

Fixed it up a bit.
I created some test data for this (A1:S6). Seems to be working ok on multiple runs:

Sub CreatePivotTable()
    Dim mySheet As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf1 As PivotField
    Dim pf2 As PivotField
    Dim pf3 As PivotField
    Dim pf4 As PivotField
    Dim mydata As Range
    
    Set mySheet = ActiveWorkbook.Sheets("TestData")
    
    For Each pt In mySheet.PivotTables
        pt.TableRange2.Clear
    Next pt


    Set mydata = mySheet.Range("A1:S6")
    Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, mydata)
    Set pt = pc.CreatePivotTable(Range("A40"), "ItemList")
    Set pf1 = pt.PivotFields("Method")
        pf1.Orientation = xlRowField
    Set pf2 = pt.PivotFields("Out of Range")
        pf2.Orientation = xlRowField
    Set pf3 = pt.PivotFields("Tracking#")
        pf3.Orientation = xlDataField
        pf3.Function = xlCount
    Set pf4 = pt.PivotFields("Tracking#")
        pf4.Orientation = xlDataField
        pf4.Function = xlCount
        pf4.Caption = "% of Method"
        pf4.Calculation = xlPercentOfTotal
        pf4.NumberFormat = "0.00%"
    
    CreatePivotChart pt
    
End Sub




Sub CreatePivotChart(pt As PivotTable)
    Dim chobj As ChartObject
    Dim ch As Chart

    Set mycheet = ActiveWorkbook.Sheets("TestData")

    For Each oCht In mycheet.ChartObjects
        oCht.Delete
    Next oCht

    Set chobj = mycheet.ChartObjects.Add(300, 500, 300, 150)
    Set ch = chobj.Chart
    ch.SetSourceData pt.TableRange1
    ch.ChartType = xlColumnClustered
    chobj.Name = "EChart1"
End Sub

 

[zookeepertx]

Hi V_Malkoti!

That's great! I made a few, small adjustments and it's terrific! I just need the Pivot Charts to appear on a new sheet in the workbook; I've named the new sheet "Pivot Charts".

Just a couple of things I need to add to it: There are several different "Methods" and each one needs to have its own Pivot Table/Pivot Chart added to the Pivot Charts sheet, below the previous ones. And the top of each Chart needs to line up with the top of its Table. I was thinking about finding the new last row each time a new Table/Chart is created and placing the new ones several rows below that, but there's no way to know how long each chart will be and the top of one Chart can't overlap the bottom of the previous one.

Here is your wonderful code with the small adjustments I've made to it:

Sub CreatePivotTable2()
    Dim mySheet As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf1 As PivotField
    Dim pf2 As PivotField
    Dim pf3 As PivotField
    Dim pf4 As PivotField
    Dim mydata As Range
    
    Set mySheet = ActiveWorkbook.Sheets(1)
    
    For Each pt In mySheet.PivotTables
        pt.TableRange2.Clear
    Next pt
    Sheets.Add
    ActiveSheet.Name = "Pivot Charts"
    Set mydata = mySheet.Range("A1:S6")
    Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, mydata)
    Set pt = pc.CreatePivotTable(Sheets("Pivot Charts").Range("A1"), "ItemList")
    Set pf1 = pt.PivotFields("Method")
        pf1.Orientation = xlRowField
    Set pf2 = pt.PivotFields("OutofRange")
        pf2.Orientation = xlRowField
    Set pf3 = pt.PivotFields("Tracking#")
        pf3.Orientation = xlDataField
        pf3.Function = xlCount
        pf3.Caption = "Count"
    Set pf4 = pt.PivotFields("Tracking#")
        pf4.Orientation = xlDataField
        pf4.Function = xlCount
        pf4.Caption = "% of Method"
        pf4.Calculation = xlPercentOfTotal
        pf4.NumberFormat = "0.00%"
    
    CreatePivotChart pt
    
End Sub


Sub CreatePivotChart(pt As PivotTable)
    Dim chobj As ChartObject
    Dim ch As Chart
    Set mySheet = ActiveWorkbook.Sheets("Pivot Charts")
    For Each oCht In mySheet.ChartObjects
        oCht.Delete
    Next oCht
    Set chobj = mySheet.ChartObjects.Add(200, 0, 300, 150)
    Set ch = chobj.Chart
    ch.SetSourceData pt.TableRange1
    ch.ChartType = xlColumnClustered
    chobj.Name = "EChart1"
End Sub

Do you know how to make it add the new Tables/Charts below the bottom of the previous Chart?

 

[V_Malkoti]

For Pivot table, you can use Range2 property to find out cells occupied by the pivottable.

strAddress = pt.TableRange2.Address

For chart you can determine the size occupied by its top, left, width and height properties.

intX = chobj.left + chobj.width
intY = chobj.top + chobj.height

You can then use these values when placing new table/chart in the spreadsheet.

 

[zookeepertx]

For Pivot table, you can use Range2 property to find out cells occupied by the pivottable.

strAddress = pt.TableRange2.Address

For chart you can determine the size occupied by its top, left, width and height properties.

intX = chobj.left + chobj.width
intY = chobj.top + chobj.height

You can then use these values when placing new table/chart in the spreadsheet.

Well, you'd THINK I'd be able to use those, but apparently I'm an idiot!! They DO give me the information that they seem to be supposed to: the range of the first table (A1:S6) and the right and bottom edges of the first Chart, but I can't figure it out from there. I've tried putting them in various places in the code and it just keeps creating more and more problems and/or errors. I don't know if I'm supposed to use strAddress (for example) like I'd use LR instead of typing the code to find the last row every time I need it or what.

Evidently, I'm just stupid. Can you explain further?

Thanks for your patience

Jenny

 

[V_Malkoti]

Quick and dirty, but this should iterate on datasets in "Result after existing macro" and take care of placement for tables and charts in "Pivot Charts".

Dim iChartHeight As Integer
Dim iChartWidth As Integer
Dim iChartLeft As Integer


Sub CreatePivotTable2()
    Dim mySheet As Worksheet, pivotSheet As Worksheet
    Dim pc As PivotCache
    Dim pt As PivotTable
    Dim pf1 As PivotField
    Dim pf2 As PivotField
    Dim pf3 As PivotField
    Dim pf4 As PivotField
    Dim mydata As Range
    Dim strFirstRowAddress As String, fromRow As Long, toRow As Long, lastRow As Long, boolRun As Boolean
    Dim oCell As Range
    Dim oPivotPos As Range, strPivotName As String, oldPivotRow As Long, newPivotRow As Long
    
    Set mySheet = ActiveWorkbook.Sheets("Result after existing macro")
    iChartHeight = 150
    iChartWidth = 300
    iChartLeft = 200
    
    On Error Resume Next
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets("Pivot Charts").Delete
    Err.Clear
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Sheets.Add
    ActiveSheet.Name = "Pivot Charts"
    Set pivotSheet = ActiveWorkbook.Sheets("Pivot Charts")
    
    fromRow = 1
    strFirstRowAddress = mySheet.Range("A1").Address
    lastRow = mySheet.Range("A1").End(xlDown).Row
    boolRun = True
    Set oPivotPos = pivotSheet.Range("A1")
    Set oCell = mySheet.Range("A:A").Find(what:="Ticket", LookIn:=xlValues)
    While Not oCell Is Nothing And boolRun
        If oCell.Address <> strFirstRowAddress Then
            toRow = oCell.Row - 1
        Else
            toRow = lastRow
            boolRun = False
        End If
        strPivotName = "ItemList_" & fromRow & "_" & toRow
        Set mydata = mySheet.Range("A" & fromRow & ":S" & toRow)
        Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, mydata)
        Set pt = pc.CreatePivotTable(oPivotPos, strPivotName)
        Set pf1 = pt.PivotFields("Method")
            pf1.Orientation = xlRowField
        Set pf2 = pt.PivotFields("OutofRange")
            pf2.Orientation = xlRowField
        Set pf3 = pt.PivotFields("Tracking#")
            pf3.Orientation = xlDataField
            pf3.Function = xlCount
            pf3.Caption = "Count"
        Set pf4 = pt.PivotFields("Tracking#")
            pf4.Orientation = xlDataField
            pf4.Function = xlCount
            pf4.Caption = "% of Method"
            pf4.Calculation = xlPercentOfTotal
            pf4.NumberFormat = "0.00%"
        
        CreatePivotChart2 pt.TableRange1, "Chart_" & fromRow & "_" & toRow
        
        ' Position for next pivot
        oldPivotRow = oPivotPos.Row
        newPivotRow = pt.DataLabelRange.End(xlDown).Row + 5
        If ((newPivotRow - oldPivotRow) < (iChartHeight / pivotSheet.StandardHeight)) Then
            newPivotRow = oldPivotRow + Round(iChartHeight / pivotSheet.StandardHeight) + 2
        End If
        Set oPivotPos = pivotSheet.Range("A" & newPivotRow)
        fromRow = toRow + 1
        Set oCell = mySheet.Range("A:A").FindNext(oCell)
    Wend
    
    ' To take care of column resizing that keeps on happening when pivot is created.
    For Each oCht In pivotSheet.ChartObjects
        oCht.Left = 200
    Next oCht
    
End Sub




Sub CreatePivotChart2(chartData As Range, chartName As String)
    Dim chObj As ChartObject
    Dim ch As Chart
    
    Set mySheet = ActiveWorkbook.Sheets("Pivot Charts")
    For Each oCht In mySheet.ChartObjects
        If oCht.Name = ChartTitle Then oCht.Delete
    Next oCht
    
    Set chObj = mySheet.ChartObjects.Add(iChartLeft, chartData.Top + 1, iChartWidth, iChartHeight)
    chObj.Chart.ChartWizard Source:=chartData, gallery:=xlColumnClustered
    chObj.Name = chartName
End Sub

 

[zookeepertx]

Quick and dirty, but this should iterate on datasets in "Result after existing macro" and take care of placement for tables and charts in "Pivot Charts".

WOOHOO!! That's darn near perfect! The only problem is that, if I just run the whole code like normal, all of the charts come out identical, based on the first Pivot Table's data. But, if I "Step Into" the code and have it stop after making the first chart, then "Continue" it from there, all of the charts turn out just fine. Weird, huh?

The ONLY other thing is - can the tables have the 3 columns like they are now, but the charts only have the Count data in them? I hate to ask, because you've got this going so nicely, so, if it's a pain, don't worry about it.

Thank you!

Jenny

 

[V_Malkoti]

That sounds like stale data issue - your spreadsheet may be preserving some old information from past code runs. Can you create a new workbook, copy-paste your source data there and then run this macro in that? That's how I tested my code with your data. No issues here.

Removing % from chart may be tricky - chart is tied to the pivot table and therefore shows whatever pivottable has. I'll see if I can find a way.

 

[zookeepertx]

That sounds like stale data issue - your spreadsheet may be preserving some old information from past code runs. Can you create a new workbook, copy-paste your source data there and then run this macro in that? That's how I tested my code with your data. No issues here.

Removing % from chart may be tricky - chart is tied to the pivot table and therefore shows whatever pivottable has. I'll see if I can find a way.

Okay, I just tried that, but it's still making all the charts from the first table's data. Now it does it when I step through, too; must have just been one of those things before, LOL. When I was thinking about it, I thought maybe it had something to do with this line - the part that I've made red:

 Set chObj = mySheet.ChartObjects.Add(iChartLeft, [COLOR=#ff0000][B]chartData.Top + 1[/B][/COLOR], iChartWidth, iChartHeight)

but I really have no idea.
(Never mind. I just thought about it harder and that doesn't even make sense)_

If the % can't be easily removed from the chart, can it just be removed from the Legend and then the % bars of the charts filled as blank instead of a color?

 

[zookeepertx]

Well, this gets even stranger!
Upon further studying, it turns out that, if I step through the ENTIRE code, including going through EACH chart as it's created, the first 3 charts use the data from table 1, then the last 2 charts are correctly based on their own data tables! Is that crazy or what?

Last night I completely restarted my computer, so I started fresh this morning, copied the large worksheet into a new sheet in a new workbook, and it's making the charts as I described above. It's just weird!

And, if I remove the "% of Method" field from any of the first 3 charts, it removes that column from the other 2 charts (meaning all 3 of the top ones) and from only the first table. But the last 2 work independently like they should.

However, as I mentioned yesterday, if I just run the whole code without stepping in, all 5 charts base themselves on the 1st table.

What to do, what to do??