Solved Create Excel Pivot Table From Access VBA (1 Viewer)

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
I have one last requirement that I need. And that is to create an excel pivot table from access vba. Using the macro recorder in Excel, thhis is what it generated. How would I change this to run with Access?

Code:
Sub Macro2()
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Quantity!R1C1:R1728C9", Version:=6).CreatePivotTable _
        TableDestination:="Sheet2!R3C1", TableName:="PivotTable2", DefaultVersion _
        :=6
    Sheets("Sheet2").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("KitNames")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable2").AddDataField ActiveSheet.PivotTables( _
        "PivotTable2").PivotFields("StoreNumber"), "Sum of StoreNumber", xlSum
    With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of StoreNumber")
        .Caption = "Count of StoreNumber"
        .Function = xlCount
    End With
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Pivot Data"
End Sub
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
What have you tried so far?
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
This is what I have tested thus far -i know i left one .Select in there as I wasn't sure how to change that one :/
Code:
Sub Macro2()
    Set pivotWS = wb.Sheets.Add(After:=wb.Worksheets("Test"))
    pivotWS.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Quantity!R1C1:R1728C9", Version:=6).CreatePivotTable _
        TableDestination:="Sheet2!R3C1", TableName:="PivotTable2", DefaultVersion _
        :=6
    Cells(3, 1).Select
    pivotWS.PivotTables("PivotTable2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With pivotWS.PivotTables("PivotTable2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    pivotWS.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
    With pivotWS.PivotTables("PivotTable2").PivotFields("KitNames")
        .Orientation = xlRowField
        .Position = 1
    End With
    pivotWS.PivotTables("PivotTable2").AddDataField pivotWS.PivotTables( _
        "PivotTable2").PivotFields("StoreNumber"), "Sum of StoreNumber", xlSum
    With pivotWS.PivotTables("PivotTable2").PivotFields("Sum of StoreNumber")
        .Caption = "Count of StoreNumber"
        .Function = xlCount
    End With
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Pivot Data"
End Sub
/code]
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
This is being run from Access?
You'll need to declare an excel application object, a workbook object, and a worksheet object.
If you are doing this using early binding (depending on the Excel object model - have a reference checked to Excel in your Tools References), then you might as well declare them as Excel.Application, Excel.Workbook and Excel.Worksheet

If you do this then your constants like xlMissingItemsDefault should be fine.
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
Oh yes, this is what I have (yes I am running in Access)

I don't understand the RXCX yet as that data will be dynamic in weeks to come, but just to get this done for now i'm leaving it hardcoded

Code:
Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
Dim pivotWS As Object

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

Set wb = xlApp.Workbooks.Open("C:\Remeediation.xlsx", False, False)
Set ws = wb.Sheets(1)

Set pivotWS = wb.Sheets.Add(After:=wb.Worksheets("Test"))
pivotWS.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Data!R1C1:R1728C9", Version:=6).CreatePivotTable _
    TableDestination:="Test!R3C1", TableName:="PivotTable2", DefaultVersion _
    :=6
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
I'm getting invalid or unqualified reference on this line (and I assume the subsequent)
Code:
        .ColumnGrand = True

I tried to do . and see if intellisense would open up but it is not :(
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
I don't understand the RXCX yet as that data will be dynamic in weeks to come, but just to get this done for now i'm leaving it hardcoded
Yeah, that concept is a little weird. In my opinion and what I do is not use R1C1 notation (although the macro recorder is obsessed with them!), and rather just use vba code to enter in the exact formula you want and then use the Autofill method to copy it down somewhere. R1C1 is almost impossible to clearly read without doing some mental tricks on what is going where.

So it's all working good?
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
I think only about half your code got posted..
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
I think only about half your code got posted..

Hah - good catch

Code:
Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
Dim pivotWS As Object

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False

Set wb = xlApp.Workbooks.Open("C:\Remeediation.xlsx", False, False)
Set ws = wb.Sheets(1)

Set pivotWS = wb.Sheets.Add(After:=wb.Worksheets("Test"))
pivotWS.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Quantity!R1C1:R1728C9", Version:=6).CreatePivotTable _
    TableDestination:="Test!R3C1", TableName:="PivotTable2", DefaultVersion _
    :=6
   
pivotWS.PivotTables("PivotTable2")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With pivotWS.PivotTables("PivotTable2").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    pivotWS.PivotTables("PivotTable2").RepeatAllLabels xlRepeatLabels
    With pivotWS.PivotTables("PivotTable2").PivotFields("KitNames")
        .Orientation = xlRowField
        .Position = 1
    End With
    pivotWS.PivotTables("PivotTable2").AddDataField pivotWS.PivotTables( _
        "PivotTable2").PivotFields("StoreNumber"), "Sum of StoreNumber", xlSum
    With pivotWS.PivotTables("PivotTable2").PivotFields("Sum of StoreNumber")
        .Caption = "Count of StoreNumber"
        .Function = xlCount
    End With
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Pivot Data"
End Sub
 
Last edited:

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
You forgot the With on this line:
pivotWS.PivotTables("PivotTable2")
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
My code hits this line and gives me the error
Object doesn't support this property or method

Code:
pivotWS.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "QuantityR1C1:R1728C9", Version:=6).CreatePivotTable _
    TableDestination:="Test!R3C1", TableName:="PivotTable2", DefaultVersion _
    :=6
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
Can you try changing
R1C1:R1728C9

to an actual cell range like A1:B1728

and the Test!R3C1 too
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
I am not entirely sure if the general concept of worksheet.pivotcaches.create().createpivottable
is valid or not.... I would depend on the macro recorder on that one I have to admit.
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
Can you try changing
R1C1:R1728C9

to an actual cell range like A1:B1728

and the Test!R3C1 too

Same error if i change the code to
Code:
pivotWS.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    "Quantity!A1:G321`", Version:=6).CreatePivotTable _
    TableDestination:="Test!A3", TableName:="PivotTable2", DefaultVersion _
    :=6

am i adding a sheet called Test? I thoguht i was, but now i don't see it...
 

Minty

AWF VIP
Local time
Today, 20:53
Joined
Jul 26, 2013
Messages
10,371
I do quite a lot of Excel manipulation and you are much better of referring to ranges than cells unless you are looping through recordsets.
 

jo15765

Registered User.
Local time
Today, 12:53
Joined
Jun 24, 2011
Messages
130
i am attempting to add a worksheet, and create a pivot table.
 

Isaac

Lifelong Learner
Local time
Today, 12:53
Joined
Mar 14, 2017
Messages
8,777
As far as your Test ws, definitely look into that, but regardless of that, Object doesn't support this property or method means that you are trying to invoke a method (like .DoSomething) or assign a value to a property, that doesn't exist. I would use the macro recorder again and scrutinize your overall structure of creating the pivotcache which then creates a pivot table...not sure that's correct.
 

Minty

AWF VIP
Local time
Today, 20:53
Joined
Jul 26, 2013
Messages
10,371
I'd actually automate a power query, that's much more fun. :cool:
 

Minty

AWF VIP
Local time
Today, 20:53
Joined
Jul 26, 2013
Messages
10,371
Automate a power query?

Can this be run thro Access VBA?
Yes. Not really a beginners project though to be fair.

I have a process that creates a spreadsheet from scratch that contains approximately 20 - 30 worksheets, each sheet has between 5- 30 tables on it with formulas, that are effectively unpivoted horizontal date pivots and include conditional formatting, sometimes up to 70 or 80 columns wide. Each sheet has colours applied to relevant to the data.

It would be fair to say that it was a lot of work, and can easily take over half an hour to run, depending on the periods and criteria selected.
The data table that drives it all just for this year's data has nearly 5000 lines, and is a tiny subset of the 3,000,000 lines in the source data.

This is all driven from Access (Data is stored in Azure, and it does a lot of the pre-processing), but once the data table is created it's all VBA from Access.
 

Users who are viewing this thread

Top Bottom