PivotCache is nothing

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:

Forum statistics

Threads
1,082,342
Messages
5,364,777
Members
400,815
Latest member
gangstar67

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top