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: