Loop to create pivot tables and bar charts

Question

I'm working on writing some VBA that is executed in a procedure in Microsoft Access that opens up a Microsoft Excel document and creates a pivot table and bar chart for each our plants & engineers. It always works for the first run, but always fails when the loop starts the process again. My code looks like the following:

Sub PlantDashboard()

    Dim dbs As Database
    Dim plants As DAO.Recordset
    Dim rsquery1, rsquery2, rsquery3 As DAO.Recordset
    Dim targetworkbook As Object
    Dim wksheet1, wksheet2  As Object
    Dim prop As Office.MetaProperty
    Dim props As Office.MetaProperties

    Set dbs = CurrentDb
    Set plants = dbs.OpenRecordset("Selected Plant/SQE")
    plants.MoveFirst
    Set plant = plants.Fields("Plant")

    Do Until plants.EOF                          'Start of loop
        Set excelapp = CreateObject("excel.application", "")
        Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")
        .
        .
        .
        Set wksheet2 = targetworkbook.worksheets("Open SQNs") 'Worksheet for pivot table and bar chart
        wksheet2.Activate
        Dim pcs As PivotCache
        Dim pts As PivotTable
        Dim pfs As PivotField

        Set rng = wksheet2.Range("A:A")          'column of vendor names placed by access query (rsquery3)
        nbropensqn = rng.SpecialCells(2).Cells.Count 'count of vendors names
        nbropensqn = nbropensqn - 2              'removes 2 headers from query from count
        wksheet2.Activate                        'maybe unnecessary to re-activate same sheet?
        wksheet2.Range("A2:E" & nbropensqn + 2).Select 'select range of data for pivot table

        Set pcs = targetworkbook.PivotCaches.Create( _
                  SourceType:=xlDatabase, _
                  SourceData:=wksheet2.Range("A2:E" & nbropensqn + 2), _
                  Version:=xlPivotTableVersion15)

        wksheet2.Activate                        'maybe unnecessary to re-activate same sheet?
        wksheet2.Range("H2").Select              'where i place the pivot table

        Set pts = pcs.CreatePivotTable( _
                  TableDestination:=wksheet2.Range("H2"))

        Set pfs = pts.PivotFields("Vendor Account Number")
        pfs.Orientation = xlRowField

        Set pfs = pts.PivotFields("Not Started")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("On Time")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("Late")
        pfs.Orientation = xlDataField

        Set pfs = pts.PivotFields("Count")
        pfs.Orientation = xlDataField

        wksheet2.Range("'Open SQNs'!$H$2:$L$" & nbropensqn).Select
        wksheet2.Shapes.AddChart2(297, xlBarStacked).Select

        wksheet2.ChartObjects("Chart 1").Activate
        ActiveChart.FullSeriesCollection(3).Select '**ERROR HERE**
        ActiveChart.PivotLayout.PivotTable.PivotFields("Vendor Account Number").AutoSort _
                                                       xlAscending, "Count of Vendor Account Number",     ActiveChart.PivotLayout.PivotTable. _
                                                                                                     PivotColumnAxis.PivotLines(4), 1 'Sort by Count of Supplier SQNs

        'BEGIN FORMATTING CHART
        ActiveChart.FullSeriesCollection(4).Select
        .
        .
        .
        ActiveChart.FullSeriesCollection(2).Select
        .
        .
        .
        ActiveChart.FullSeriesCollection(3).Select
        .
        .
        .
        'END FORMATTING CHART
        'SELECT COPY AND PASTE CHART TO DIFFERENT WORKSHEET
        ActiveChart.ChartArea.Select
        Selection.Copy
        wksheet1.Activate
        ActiveSheet.Range("A32").Select
        ActiveSheet.Paste

        'CONTINUE WITH REST OF CODE
        'Save and close targetworkbook
        'excelapp.Application.Quit

        plants.MoveNext                          'Move to next "plant" in plants
    Loop

End Sub

The first iteration runs and saves perfectly. By the 2nd iteration I get an error at this line

ActiveChart.FullSeriesCollection(3).Select

RUN TIME ERROR 1004: METHOD 'ACTIVECHART' OF OBJECT '_GLOBAL' FAILED

I have no idea why it does not like how i have selected the full series collection after allowing me to activate the active chart on the page. Do I need to reset one of my variables? Do I need to select the active chart created in a different way?

Any insights into this would be appreciated!

Answer 1

The first issue I raise is unrelated to the question, but will surely speed up your code. In the below lines:

Do Until plants.EOF 'Start of loop
    Set excelapp = CreateObject("excel.application", "")
    Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")
.

You create an Excel object and open the template on Each loop. Why? It's not necessary and wastes resources and creates longer run-time.

Do this instead:

Set excelapp = CreateObject("excel.application", "")
Set targetworkbook = excelapp.Workbooks.Open("H:\Plant SQE DB\Plant SQE DB - Template.xlsx")

Do Until plants.EOF 'Start of loop

If you need to save the template for each chart, you can do so at the end like this:

targetworkbook.SaveAs newFileName

Now, onto the issues with ActiveChart. Modify these lines:

wksheet2.Shapes.AddChart2(297, xlBarStacked).Select
wksheet2.ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(3).Select 

To:

Dim cht as Object
Set cht = wksheet2.Shapes.AddChart2(297, xlBarStacked)

With cht.FullSeriesCollection(3)
    ...

And follow suit for all lines below. Every time you see ActiveChart, move the method inside the With Statement and work directly with the object (eliminate all select statements)