goingcrazzy

New Member
Joined
Nov 18, 2013
Messages
1
Hello, I am needing assistance with PivotCaches. I am including code below that is intended to have access export qryExport to excel, then the code is supposed to create multiple pivots on the Pivots sheet based on the qryExport. I have gotten it to work a couple times, but not consistently. When I step through the code looking at the locals screen, it says the pivotcahce is nothing. It has a sourcedata, and thats it. Any help would be very apprecialted!


Code:
Public Function FixIt()
Dim bnRefresh As Boolean, intCount As Integer, intTINCount As Integer, lnTINS(1, 1000) As Long, rngRng As Range, strPivots As String
Dim pivPivots As PivotTables, pivPivt As PivotTable, pvt As PivotField, pivCache As PivotCache, lnTop As Long, lnBottom As Long, prvtTable As PivotTable
'Initialize variables
On Error GoTo Errs
Sheets("qryExport").Activate
bnExit = 0
intTINCount = 1
intCount = Sheets("qryExport").Range("B65000").End(xlUp).Row
lnTINS(0, 0) = 1
lnTINS(1, 0) = Sheets("qryExport").Cells("2", "B")
'Need to loop through all the tins to note each change and put on a new pivot
For i = 1 To intCount
    If Sheets("qryExport").Cells(i, "B") <> lnTINS(1, intTINCount - 1) And Sheets("qryExport").Cells(i, "B") <> "TIN" Then
        lnTINS(0, intTINCount) = intTINCount + 1
        lnTINS(1, intTINCount) = Sheets("qryExport").Cells(i, "B")
        intTINCount = intTINCount + 1
    End If
Next
lnTINS(0, intTINCount) = intTINCount + 1
lnTINS(1, intTINCount) = intCount
'Set up a named range for the data
Set pivPivots = Sheets("Pivots").PivotTables
Sheets("qryExport").Names.Add "pvtData", "=qryExport!" & Sheets("qryExport").Range("A1:I" & intCount).Address, True
'set the pivot cache to the named range. Yhis is all our data for all the pivots
Set pivCache = ThisWorkbook.PivotCaches.Create(xlDatabase, Sheets("qryExport").Range("pvtData").Address)
'loop through each tin to create pivots
For intCount = 1 To intTINCount
    lnTin = lnTINS(1, intCount - 1)
'create the pivot table
    CreatePivt pivPivt, intCount, lnTINS(1, intCount - 1), lnTINS(1, intTINCount), strPivots, prvtTable, pivCache
'turn off updates while performing setup
    pivPivt.ManualUpdate = True '    If pivPivt.PivotFields.Count > 0 Then
'declare where our row/column data comes from
    pivPivt.AddFields ColumnFields:=Array("LOBNet"), RowFields:=Array("TIN")
 'Set table defaults
    With pivPivt
        .LayoutRowDefault = xlCompactRow
        .ColumnGrand = False
        .RowGrand = False
        .ShowTableStyleColumnHeaders = True
        .ShowTableStyleColumnStripes = True
        .TableStyle2 = "PivotTable Style 1"
        .SubtotalHiddenPageItems = False
        .VisualTotals = False
        .RowAxisLayout xlTabularRow
    End With
'Setting row properties
    For Each pvt In pivPivt.PivotFields
        If pvt.Name = "TIN" Or pvt.Name = "Provider" Or pvt.Name = "ProvName" Or pvt.Name = "Term_Network" Or pvt.Name = "Spec_Desc" Or pvt.Name = "BlackSheep_Ind" Then
            pvt.Orientation = xlRowField ', "Provider"
            pvt.Subtotals(1) = True
            pvt.Subtotals(1) = False
            Select Case pvt.Name
                Case "TIN": pvt.Position = 1
                Case "Provider": pvt.Position = 2
                Case "ProvName": pvt.Position = 3
                Case "Term_Network": pvt.Position = 4
                Case "Spec_Desc": pvt.Position = 5
                Case "BlackSheep_Ind": pvt.Position = 6
            End Select
        End If
    Next
'set pivot data properties
    With pivPivt.PivotFields("LOBNet")
        .Orientation = xlDataField
        .Function = Max
        .Position = 1
    End With
'hide rows that dontapply to this tin
    Set pvt = pivPivt.PivotFields("TIN")
    For A = 0 To intTINCount - 1
        If lnTINS(1, A) = lnTin Then
            pvt.PivotItems("" & lnTINS(1, A) & "").Visible = True
        Else
            pvt.PivotItems("" & lnTINS(1, A) & "").Visible = False
        End If
    Next
'update table
    pivPivt.ManualUpdate = False
    pivPivt.ManualUpdate = True
'set this table to the back burner to determine where to place the next
    Set prvtTable = pivPivt
'clear everything for next run through
    Set pvt = Nothing
    Set pivPivots = Nothing
    Set pivPivt = Nothing
Next
Exit Function
Errs:
Err.Raise Err.Number, Err.Source, Err.Description
Resume
End Function
Private Function CreatePivt(ByRef pvtTable As PivotTable, intNbr As Integer, lnTin As Long, lnLastRow As Long, ByRef strPivots As String, ByRef prvtTable As PivotTable, Optional ByRef pvtCache As PivotCache) As PivotTable
Dim intLoc As Integer, strFindIt As String, intFindIt As Integer
'On Error Resume Next
intFindIt = 1
'find where to place the table on Pivots
If Not intNbr = 1 Then
    strFindIt = prvtTable.RowRange.Address
    Do Until InStr(intFindIt + 1, strFindIt, "$", vbTextCompare) = 0
        intFindIt = InStr(intFindIt + 1, strFindIt, "$", vbTextCompare)
    Loop
    strFindIt = Right(strFindIt, Len(strFindIt) - intFindIt)
    intLoc = Int(strFindIt) + 2
Else
    intLoc = 1
End If
Sheets("Pivots").Activate
'create the pivottable
Set pvtTable = Nothing
    Set pvtTable = pvtCache.CreatePivotTable(TableDestination:="")
    strPivots = pvtTable.Name
End Function
 
Last edited:

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Forum statistics

Threads
1,214,786
Messages
6,121,548
Members
449,038
Latest member
Guest1337

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