Solved Create Excel Pivot Table From Access VBA

[Darrell]

I have a function that pretty much does this, hopefully it might help you if you can modify it to your needs

Function Output_Fact_Hrs_Excel(FPAth As String)
On Error GoTo ErrorHandler

Dim fName As String
Dim strSheet As String
Dim MyFile As String
Dim appExcel As Object
Dim MyBook As Object
Dim MySheet As Object

fName = "Factory Hours.xls"         ' Data file to overwrite

MyFile = FPAth & fName              ' Point to the Data file

' Create the data file
Set appExcel = GetObject(, "Excel.Application")
 
DoCmd.OutputTo acOutputQuery, "qry Conf Hrs ~ Wk_Center", acFormatXLS, MyFile, False, ""
   
Set MyBook = appExcel.Workbooks.Open(MyFile)
Set MySheet = MyBook.Sheets(1)

' Modify the data file
With appExcel
    Dim PV1Sheet As Object
    Dim LoopCtr, FinalRow As Long
   
    .ScreenUpdating = False
    With MySheet
        .Range("A1") = "Work Center"
        .Range("B1") = "Conf. Date"
        .Range("C1") = "Act. Lab"
        .Range("D1") = "OT Lab"
        .Range("E1") = "Total Lab"
        .Rows(1).Font.Bold = True
        .Cells.EntireColumn.AutoFit
        FinalRow = .UsedRange.Rows.Count
        MyBook.Sheets.Add After:=MySheet
    End With

    Set PV1Sheet = MyBook.Sheets(2)
    With PV1Sheet
        .Activate
        .Name = "Totals"
        MyBook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
            "qry Conf Hrs ~ Wk_Center!R1C1:R" & FinalRow & "C5").CreatePivotTable TableDestination:=.Range("A1"), TableName:= _
            "PivotTable1", DefaultVersion:=xlPivotTableVersion10
        .PivotTableWizard TableDestination:=.Cells(3, 1)
        .Cells(3, 1).Select
        With PV1Sheet.PivotTables("PivotTable1")
            .PivotFields("Work Center").Orientation = xlRowField
            .AddDataField .PivotFields("Act. Lab"), "Sum of Act. Lab", xlSum
            .AddDataField .PivotFields("OT Lab"), "Sum of OT Lab", xlSum
            .AddDataField .PivotFields("Total Lab"), "Sum of Total Lab", xlSum
            .DataPivotField.Orientation = xlColumnField
        End With
    End With
    appExcel.ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    appExcel.ActiveWindow.TabRatio = 0.195
    MyBook.Save
End With

ErrorHandlerExit:
    appExcel.ScreenUpdating = True
    Set appExcel = Nothing
    Set PV1Sheet = Nothing
    Set MyBook = Nothing
    Set MySheet = Nothing
    Exit Function

ErrorHandler:
    If Err = 429 Then   ' Excel is not running; open Excel with CreateObject
        Set appExcel = CreateObject("Excel.Application")
        appExcel.Visible = True
        Resume Next
    Else
       MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
       Resume ErrorHandlerExit
    End If

End Function

 

[jo15765]

even when I try your code, this line still gives me an error

        MyBook.PivotCaches.Add(.....

 

[bastanu]

Have a look at my free utility: http://forestbyte.com/ms-access-utilities/fba-pivot-table-designer/

Cheers,
Vlad

 

[jo15765]

@bastanu - thanks for posting this. If I am understanding tho, this will allow creation of a pivot table in access.

I need to use access vba to create a pivot table in excel

 

[bastanu]

Access no longer supports pivot tables, my utility allows you to "mock-up" the pivot in an Access form and then creates the Excel file and the pivot just like you try to do. Have a look at the code and maybe it helps you with where you got stuck.

Cheers,

 

[jo15765]

I finally figured it out. This is the syntax I have in case anyone coming back here later on needs the same assistance as I

Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
Dim LastColumn As Long
Dim pivotWS As Excel.Worksheet, dataWS As Excel.Worksheet
Dim PCache As Excel.PivotCache
Dim PTable As Excel.PivotTable
Dim PRange As Excel.Range

wb.Sheets.Add(Before:=Excel.ActiveSheet).Name = "PivotTable"

Set pivotWS = wb.Worksheets("PivotTable")
Set dataWS = wb.Worksheets("Quantity")

LastColumn = dataWS.Cells(1, Columns.Count).End(xlToLeft).Column

Set PRange = dataWS.Cells(1, 1).Resize(LastRow, LastColumn)

Set PCache = Excel.ActiveWorkbook.PivotCaches.Create(SourceType:=Excel.xlDatabase, SourceData:=PRange)
Set PTable = PCache.CreatePivotTable(TableDestination:=pivotWS.Cells(3, 1), TableName:="TestPivotTable")

With PTable.PivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = Excel.xlMissingItemsDefault
End With

PTable.RepeatAllLabels xlRepeatLabels

wb.Save

With PTable.PivotFields("EmpNames")
    .Orientation = Excel.xlRowField
    .Position = 1
End With

With PTable.PivotFields("EmployeeNumber")
    .Orientation = Excel.xlDataField
    .Caption = "Count of EmployeeNumber"
   .Function = Excel.xlCount
End With