Run Time error 13 - Type Mismatch Error - Creating PivotCache

[mtdewrocks]

I am having an issue with my coding for creating a pivotcache - It worked perfectly in another spreadsheet; however, an update was done to the data and the column order changed so I needed to tweak some other code. I never touched the PTCache coding and it works perfectly in the other spreadsheet - can someone please identify what I need to do to create the pivot cache correctly?

Thanks!

Sub PivotTables()
' This procedure creates multiple pivot tables

Dim PTCache As PivotCache
Dim pt As Pivottable
Dim SummarySheet As Worksheet
Dim ItemName As String
Dim Row As Long, Col As Long, i As Long, k As Long
Dim Period As String
Dim QBPRCOML As String
Dim UpdatedREGION As String
Dim QuarterYear As String
Dim Q_10 As Range
Dim lastrow As Range
Dim Cert As Long
Dim BankName As String
Dim CertNumber As String
Dim Region As String
Dim iLastRow As Integer
Dim CallYMD As String
Dim Quarter As String
Dim Year As String


'Delete any charts in spreadsheet
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Question 4").Delete
Sheets("Question 5").Delete
Sheets("Question 6").Delete
Sheets("Question 6_a").Delete
Sheets("Question 7").Delete
Sheets("Question 8").Delete
Sheets("Question 9").Delete
Sheets("Question 10").Delete
Sheets("Question 11").Delete
Sheets("Question 12").Delete
Sheets("Question 13").Delete
On Error GoTo 0
Worksheets("MASTER").Activate
iLastRow = Worksheets("MASTER").Range("A" & Rows.Count).End(xlUp).Row

'Inserts column to put question 10 data into
If Worksheets("MASTER").Range("AK1").Value = "Q_10" Then Columns("AK:AK").Delete Shift:=xlToLeft
Columns("AK:AK").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AK1").Value = "Q_10"
'From Row 2 (Assuming Row 1 is a Header Row) to the last row with a region location.
For Cert = 2 To iLastRow Step 1

'Tests to see if any Regions are empty to ensure all surveys are included in pivot tables
If Worksheets("MASTER").Cells(Cert, 16) = "" Then
'If the region that corresponds to the cert is blank then get the bank name and cert number

BankName = Cells(Cert, 5).Value
CertNumber = Cells(Cert, 3).Value

'Region = InputBox(BankName & "'s" & " (Cert Number " & CertNumber & ")" & " region is empty. Please enter either KC, CHI, or DAL")
MsgBox BankName & "'s" & " (Cert Number " & CertNumber & ")" & " region is empty. Please click OK and select appropriate region."
'Call SelectRegionfromListBox

Regionform.Show
Cells(Cert, 16) = Regionform.Regionlist.Value
'Cells(Cert, 5).Value = UCase(Region)
'Sets the blank region equal to the input by the user and makes it uppercase
End If
'Loop back around to check all surveys have a region code
Next Cert

For k = 2 To iLastRow
'Set Q_10 = Cells(k, 37)
Application.ScreenUpdating = False
Cells(k, 37).Select
If ActiveCell.Offset(0, 1) = "" And ActiveCell.Offset(0, 2) = "" And ActiveCell.Offset(0, 3) = "" And ActiveCell.Offset(0, 4) = "1" Then
ActiveCell = "1"
ElseIf ActiveCell.Offset(0, 1) = "1" And ActiveCell.Offset(0, 2) = "1" And ActiveCell.Offset(0, 3) = "1" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "2"
ElseIf ActiveCell.Offset(0, 1) = "" And ActiveCell.Offset(0, 2) = "1" And ActiveCell.Offset(0, 3) = "" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "3"
ElseIf ActiveCell.Offset(0, 1) = "" And ActiveCell.Offset(0, 2) = "1" And ActiveCell.Offset(0, 3) = "1" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "4"
ElseIf ActiveCell.Offset(0, 1) = "1" And ActiveCell.Offset(0, 2) = "1" And ActiveCell.Offset(0, 3) = "" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "5"
ElseIf ActiveCell.Offset(0, 1) = "1" And ActiveCell.Offset(0, 2) = "" And ActiveCell.Offset(0, 3) = "" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "6"
ElseIf ActiveCell.Offset(0, 1) = "" And ActiveCell.Offset(0, 2) = "" And ActiveCell.Offset(0, 3) = "1" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "7"
ElseIf ActiveCell.Offset(0, 1) = "1" And ActiveCell.Offset(0, 2) = "" And ActiveCell.Offset(0, 3) = "1" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = "8"
ElseIf ActiveCell.Offset(0, 1) = "1" And ActiveCell.Offset(0, 2) = "1" And ActiveCell.Offset(0, 3) = "1" And ActiveCell.Offset(0, 4) = "1" Then
ActiveCell = "1"
ElseIf ActiveCell.Offset(0, 1) = "" And ActiveCell.Offset(0, 2) = "" And ActiveCell.Offset(0, 3) = "" And ActiveCell.Offset(0, 4) = "" Then
ActiveCell = ""
End If
'Loop around to get all appropriate responses for question 10
Next k




' Delete Summary sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary").Delete
On Error GoTo 0

' Add Summary sheet
Set SummarySheet = Worksheets.Add
ActiveSheet.Name = "Summary"

' Create Pivot Cache -- The code below is where I get the error - however, it works perfectly in the old spreadsheet!
Set PTCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Sheets("MASTER").Range("A1"). _
CurrentRegion)

 

[mtdewrocks]

I got it figured out - there was some issues with extra data at the end of the spreadsheet that was causing an issue.