davemcwish
New Member
- Joined
- Nov 12, 2013
- Messages
- 11
I've a problem with PivotCaches.Create method generating a Type mismatch error 13.
If I run the module against dataset #1 (1151 rows x 17 columns) I have no problems. Against dataset #2 which has the same structure but larger number of records (1151 rows x 17 columns) and different data elements I get type mismatch with the line
Based on other posts, I've tried
both giving me Invalid procedure call or argument
Changing the method of setting range also has no effect
Other posts have suggested problems with large > 60,000 records but as I've got so few I'm stumped.
Any thoughts ?
The whole module is
If I run the module against dataset #1 (1151 rows x 17 columns) I have no problems. Against dataset #2 which has the same structure but larger number of records (1151 rows x 17 columns) and different data elements I get type mismatch with the line
Code:
390 Set objPivotCachePrerequsite = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngPivotSourceData, Version:=xlPivotTableVersion14)
Based on other posts, I've tried
Code:
Set objPivotCachePrerequsite = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rngPivotSourceData.Address(, , , True))
Code:
390 Set objPivotCachePrerequsite = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:="'" & rngPivotSourceData.Parent.Name & "'!" & rngPivotSourceData.Address(True, True, xlR1C1))
both giving me Invalid procedure call or argument
Changing the method of setting range also has no effect
Code:
385 Set rngPivotSourceData = objDataWorksheet.Cells(1, 1).CurrentRegion
Other posts have suggested problems with large > 60,000 records but as I've got so few I'm stumped.
Any thoughts ?
The whole module is
Code:
'Pivots
Dim objPivotCachePrerequsite As Excel.PivotCache 'pivot table reference used for prerequsite and gained pivot table cache
Dim objPivotCacheGained As Excel.PivotCache 'pivot table reference used for variance pivot table cache
Dim objPivotCacheVariance As Excel.PivotCache 'pivot table reference used for variance pivot table cache
Dim objPivotTablePrerequsite As Excel.PivotTable 'pivot table reference used for prerequsite pivot table
Dim objPivotTableGained As Excel.PivotTable 'pivot table reference used for gained pivot table
Dim objPivotTableVariance As Excel.PivotTable 'pivot table reference used for variance pivot table
'Data Ranges
Dim rngPivotSourceData As Range 'Data range used for pivot cache
Dim lngLastDataRow As Long 'Variable used to determine last row of data. As there may be more than 32767 records processed use Long as opposed to Integer
Dim intLastDataColumn As Integer 'Variable used to determine last column of data
Dim strProcedureName As String
Dim strEmailErrorText As String 'Text string containing the error message text to email
'Timer variables used get stats on how long code takes to execute
'The High-Res Timer code is from http://support.microsoft.com/kb/172338 and http://bytecomb.com/accurate-performance-timers-in-vba/
Dim curFreqStart As Currency
Dim curFreqEnd As Currency
Dim curFreq As Currency
Dim curAPIOverhead As Currency
Dim curMacroTimerStart As Currency
Dim curMacroTimerInitialise As Currency
Dim curMacroTimerSharePointDataRefresh As Currency
Dim curMacroTimerCDFDataReformat As Currency
Dim curMacroTimerDataNormalise As Currency
Dim curMacroTimerPivotCreate As Currency
Dim curMacroTimerWorkbookSave As Currency
Dim curMacroTimerFinish As Currency
'Low-res timer variables
Dim dblStartTime As Double
Dim dblEndTime As Double
'Set up Error handler
On Error GoTo ErrHandler:
'Module name
10 strProcedureName = "Generate_Pivot(" & strDataWorksheetName & ", " & strPivotWorksheetName & ")"
'Start the High-Res Timer
20 If QueryPerformanceCounter(curFreqStart) Then
30 QueryPerformanceCounter curFreqEnd
40 QueryPerformanceFrequency curFreq
50 curAPIOverhead = curFreqEnd - curFreqStart
60 Else
70 Debug.Print "High-resolution counter not supported."
80 End If
'Start macro timers
90 dblStartTime = GetTickCount ' Get low-res start time
100 QueryPerformanceCounter curMacroTimerStart ' Get high-res start time
'Let Excel do something
110 DoEvents
'Check to see if there's an active workbook
120 If ActiveWorkbook Is Nothing Then
130 Call MsgBox("There is no active workbook!" & vbNewLine & vbNewLine & "Macro will now terminate. Please contact support", vbExclamation + vbSystemModal, strToolName)
140 Exit Sub
150 End If
'If Denormalised Data Worksheet exists then delete and recreate
160 If WorksheetExists(strDataWorksheetName) Then
'Do nothing
170 Else
180 Call MsgBox("Data worksheet" & vbNewLine & vbNewLine & strDataWorksheetName & "doesn't exist!" & vbNewLine & vbNewLine & "Macro will now terminate. Please contact support", vbExclamation + vbSystemModal, strToolName)
190 End If
'If Pivot Worksheet exists
200 If WorksheetExists(strPivotWorksheetName) Then
'delete and recreate
210 WorksheetDelete (strPivotWorksheetName)
220 ThisWorkbook.Worksheets.Add After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
230 ThisWorkbook.ActiveSheet.Name = strPivotWorksheetName
240 Else
'CombinedDenormalised Worksheet does not exist so create at end of WorkBook
250 ThisWorkbook.Worksheets.Add After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
260 ThisWorkbook.ActiveSheet.Name = strPivotWorksheetName
270 End If
'Worksheet References
Dim objPivotWorksheet As Worksheet 'Reference to multiple pivot table worksheet
Dim objDataWorksheet As Worksheet 'Reference to Denormalised worksheet
280 Set objPivotWorksheet = ThisWorkbook.Worksheets(strPivotWorksheetName)
290 Set objDataWorksheet = ThisWorkbook.Worksheets(strDataWorksheetName)
300 QueryPerformanceCounter curMacroTimerInitialise ' High-res
310 QueryPerformanceCounter curMacroTimerSharePointDataRefresh ' High-res
320 QueryPerformanceCounter curMacroTimerCDFDataReformat ' High-res
330 QueryPerformanceCounter curMacroTimerDataNormalise ' High-res
'Define range for prerequsite pivot will use
340 With ActiveWorkbook.Sheets(objDataWorksheet.Name)
350 lngLastDataRow = .Range("A1").End(xlDown).Row
360 intLastDataColumn = .Range("A1").End(xlToRight).Column
370 Set rngPivotSourceData = .Range("A1", .Cells(lngLastDataRow, intLastDataColumn))
380 End With
'create pivot cache for Prerequsite Pivot Table
390 Set objPivotCachePrerequsite = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngPivotSourceData, Version:=xlPivotTableVersion14)
'create PivotPrerequsiteNumber pivot table
400 Set objPivotTablePrerequsite = objPivotCachePrerequsite.CreatePivotTable(TableDestination:=Worksheets(objPivotWorksheet.Name).Range("A1"), TableName:="PivotPrerequsite", DefaultVersion:=xlPivotTableVersion14)
410 With objPivotWorksheet.PivotTables("PivotPrerequsite")
420 .InGridDropZones = True
430 .RowAxisLayout xlTabularRow
440 End With
450 With ThisWorkbook.ActiveSheet.PivotTables("PivotPrerequsite")
460 .PivotFields("Area of Competency / Behaviour").Orientation = xlRowField
470 .PivotFields("Area of Competency / Behaviour").Position = 1
480 .PivotFields("LL5 Manager").Orientation = xlPageField
490 .PivotFields("LL5 Manager").Position = 1
500 .PivotFields("State").Orientation = xlPageField
510 .PivotFields("State").Position = 1
520 .PivotFields("Competency / Behaviour Level").Orientation = xlColumnField
530 .PivotFields("Competency / Behaviour Level").Position = 1
540 .AddDataField ThisWorkbook.ActiveSheet.PivotTables("PivotPrerequsite").PivotFields("Role Identifier"), "Count of Role Identifier", xlCount
550 .PivotFields("State").ClearAllFilters
560 .PivotFields("State").CurrentPage = "Prerequsite"
570 .GrandTotalName = "Total # of Roles"
580 End With
'create pivot cache for Gained Pivot Table
590 Set objPivotCacheGained = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngPivotSourceData, Version:=xlPivotTableVersion14)
'create PivotGainedNumber pivot tables
600 Set objPivotTableGained = objPivotCacheGained.CreatePivotTable(TableDestination:=Worksheets(objPivotWorksheet.Name).Range("A35"), TableName:="PivotGained", DefaultVersion:=xlPivotTableVersion14)
610 With objPivotWorksheet.PivotTables("PivotGained")
620 .InGridDropZones = True
630 .RowAxisLayout xlTabularRow
640 End With
650 With ThisWorkbook.ActiveSheet.PivotTables("PivotGained")
660 .PivotFields("Area of Competency / Behaviour").Orientation = xlRowField
670 .PivotFields("Area of Competency / Behaviour").Position = 1
680 .PivotFields("LL5 Manager").Orientation = xlPageField
690 .PivotFields("LL5 Manager").Position = 1
700 .PivotFields("State").Orientation = xlPageField
710 .PivotFields("State").Position = 1
720 .PivotFields("Competency / Behaviour Level").Orientation = xlColumnField
730 .PivotFields("Competency / Behaviour Level").Position = 1
740 .AddDataField ThisWorkbook.ActiveSheet.PivotTables("PivotGained").PivotFields("Role Identifier"), "Count of Role Identifier", xlCount
750 .PivotFields("State").ClearAllFilters
760 .PivotFields("State").CurrentPage = "Gained"
770 .GrandTotalName = "Total # of Roles"
780 End With
'create pivot cache for variance Pivot Table
790 Set objPivotCacheVariance = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngPivotSourceData, Version:=xlPivotTableVersion14)
'create PivotVarianceNumber pivot tables
800 Set objPivotTableVariance = objPivotCacheVariance.CreatePivotTable(TableDestination:=Worksheets(objPivotWorksheet.Name).Range("A69"), TableName:="PivotVariance", DefaultVersion:=xlPivotTableVersion14)
810 With objPivotWorksheet.PivotTables("PivotVariance")
820 .InGridDropZones = True
830 .RowAxisLayout xlTabularRow
840 End With
850 With ThisWorkbook.ActiveSheet.PivotTables("PivotVariance")
860 .PivotFields("Area of Competency / Behaviour").Orientation = xlRowField
870 .PivotFields("Area of Competency / Behaviour").Position = 1
880 .PivotFields("LL5 Manager").Orientation = xlPageField
890 .PivotFields("LL5 Manager").Position = 1
900 .PivotFields("State").Orientation = xlRowField
910 .PivotFields("State").Position = 2
920 .PivotFields("State").CalculatedItems.Add "Variance", "=Gained-Prerequsite", True
930 .PivotFields("Competency / Behaviour Level").Orientation = xlColumnField
940 .PivotFields("Competency / Behaviour Level").Position = 1
950 .AddDataField ThisWorkbook.ActiveSheet.PivotTables("PivotGained").PivotFields("Role Identifier"), "Count of Role Identifier", xlCount
960 .PivotFields("State").ClearAllFilters
'.PivotFields("State").CurrentPage = "Gained"
970 .GrandTotalName = "Total # of Roles"
980 End With
'Tidy up column widths
990 Columns("B:I").Select
1000 Selection.ColumnWidth = 15
1010 Range("F15").Select
'Add Harvey Balls formatting to Prerequsite pivot
1020 Range("B6").Select
1030 Selection.FormatConditions.AddIconSetCondition
1040 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
1050 With Selection.FormatConditions(1)
1060 .ReverseOrder = False
1070 .ShowIconOnly = False
1080 .IconSet = ActiveWorkbook.IconSets(xl5Quarters)
1090 End With
1100 With Selection.FormatConditions(1).IconCriteria(2)
1110 .Type = xlConditionValuePercent
1120 .Value = 20
1130 .Operator = 7
1140 End With
1150 With Selection.FormatConditions(1).IconCriteria(3)
1160 .Type = xlConditionValuePercent
1170 .Value = 40
1180 .Operator = 7
1190 End With
1200 With Selection.FormatConditions(1).IconCriteria(4)
1210 .Type = xlConditionValuePercent
1220 .Value = 60
1230 .Operator = 7
1240 End With
1250 With Selection.FormatConditions(1).IconCriteria(5)
1260 .Type = xlConditionValuePercent
1270 .Value = 80
1280 .Operator = 7
1290 End With
1300 Selection.FormatConditions(1).ScopeType = xlSelectionScope
1310 Selection.Copy
1320 Application.CutCopyMode = False
1330 Selection.Copy
1340 Range("B6:G27").Select
1350 Selection.PasteSpecial Paste:=xlPasteFormats, operation:=xlNone, SkipBlanks:=False, Transpose:=False
1360 Application.CutCopyMode = False
1370 ActiveWindow.SmallScroll Down:=9
'Copy Harvey Balls formatting from Prerequsite pivot to Gained pivot
1380 Selection.Copy
1390 Range("B37:H58").Select
1400 Selection.PasteSpecial Paste:=xlPasteFormats, operation:=xlNone, SkipBlanks:=False, Transpose:=False
1410 Application.CutCopyMode = False
'Format variance cells with -ve numbers as red text with red shading
1420 Range("A71:G159").Select
1430 Application.CutCopyMode = False
1440 Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=0"
1450 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
1460 With Selection.FormatConditions(1).Font
1470 .Color = -16383844
1480 .TintAndShade = 0
1490 End With
1500 With Selection.FormatConditions(1).Interior
1510 .PatternColorIndex = xlAutomatic
1520 .Color = 13551615
1530 .TintAndShade = 0
1540 End With
1550 Selection.FormatConditions(1).StopIfTrue = False
'Resize Columns on Pivot Worksheet
1560 objPivotWorksheet.Activate
1570 Columns("B:G").Select
1580 Selection.ColumnWidth = 15
'Get time taken
1590 QueryPerformanceCounter curMacroTimerPivotCreate
'Save Workbook
1600 ThisWorkbook.Save
1610 QueryPerformanceCounter curMacroTimerWorkbookSave
'Get time taken
1620 QueryPerformanceCounter curMacroTimerFinish
1630 dblEndTime = GetTickCount
'Write code execution timings to Log worksheet
1640 Call WriteLogData(strProcedureName, lngLastDataRow - 1, curAPIOverhead, curFreq, curMacroTimerStart, curMacroTimerInitialise, curMacroTimerSharePointDataRefresh, curMacroTimerCDFDataReformat, curMacroTimerDataNormalise, curMacroTimerPivotCreate, curMacroTimerWorkbookSave, curMacroTimerFinish, dblStartTime, dblEndTime)
'Clear Clipboard
1650 Call ClearClipboard
'Let Excel do something
1660 DoEvents
ErrHandler:
1670 If Err.Number <> 0 Then
1680 strEmailErrorText = "Runtime Error" & vbCrLf & vbCrLf & "Module: " & Application.VBE.ActiveCodePane.CodeModule.Name & vbCrLf & "Procedure: " & strProcedureName & vbCrLf & "Line: " & Erl & vbCrLf & vbCrLf & DisplayADSIError()
1690 Call MsgBox(strEmailErrorText, vbCritical + vbSystemModal, strToolName)
1700 Call Email_Support(strEmailErrorText)
1710 End If
End Sub 'End Sub Generate_Pivot()