Exel 2010 Error 1004 or 5 when creating pivot table

[nesher123]

I have been working to resolve these errors on my code for over a week now and decided to ask for help from the forum.

My code creates a pivot table from a dynamic range. The errors occur at:

'Step 13 ARGHHHHHHHHHHH!!!!: create the pivot table
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveWorkbook.Sheets("SYSTEM").Range("rng1")) _
.CreatePivotTable _
Tabledestination:="", _
TableName:="PivotTable2", _
Defaultversion:=xlPivotTableVersion14

I've tried lots of various suggested tweeks and sometimes get the macro to run through once but it bombs on the second pass with error 1004. I understand this is a know issue but using the suggestions from Microsoft didn't resolve the error.

The full code is below. I would appreciate any assistance!

'Step 1.Define variables and objects

Private Sub GENERATE_WORKBOOK2()
Dim strSQL As String
Dim RS As Recordset
Dim xlapp As Object
Dim xlwkbk As Workbook
Dim xlsheet As Worksheet
Dim xlsheet2 As Worksheet
Dim cell As Range
Dim outputfilename As String
Dim outputfile As String
Dim mysystem As String
Dim mypath As String
Dim pvtcache As PivotCache
Dim pvtTable As PivotTable
Dim rng1 As Range
Dim lastrow As Long
Dim lastcol As Long
Dim Daytime As String


'Step 2 GOOD: Create a name and path for the file using form fields cbosystemselect and txtfilepath
mysystem = Screen.ActiveForm.cboSelectSystem.Value
mypath = Screen.ActiveForm.txtFilePath.Value
Daytime = Format(CStr(Now), "yyymmdd_hhmm")

outputfile = mysystem & "_" & Daytime & ".xlsx"
outputfilename = mypath & "\" & outputfile

'Step 3 GOOD: Create an sql query to select the records i want

strSQL = "SELECT tblMSPCodes.SYSTEM,"
strSQL = strSQL & " " & "tblMUFiles.EVENT,"
strSQL = strSQL & " " & "tblBunoOrg.WING,"
strSQL = strSQL & " " & "tblBunoOrg.CVW,"
strSQL = strSQL & " " & "tblBunoOrg.COMMAND,"
strSQL = strSQL & " " & "tblMUFiles.BUNO ,"
strSQL = strSQL & " " & "tblMUFiles.LOT,"
strSQL = strSQL & " " & "tblMUFiles.FLIGHTFLAG,"
strSQL = strSQL & " " & "tblMUFiles.MU_FILE,"
strSQL = strSQL & " " & "tblMUFiles.Date,"
strSQL = strSQL & " " & "tblMUFiles.MSP_CAW,"
strSQL = strSQL & " " & "tblMSPCodes.[MSP_CAW DESCRIPTION],"
strSQL = strSQL & " " & "tblMSPCodes.[CRITICAL CODE],"
strSQL = strSQL & " " & "tblMSPCodes.CMSP, "
strSQL = strSQL & " " & "tblBunoOrg.TEC,"
strSQL = strSQL & " " & "tblBunoOrg.TMS"
strSQL = strSQL & " " & "FROM (tblMSPCodes INNER JOIN tblMUFiles "
strSQL = strSQL & " " & "ON tblMSPCodes.MSP_CAW = tblMUFiles.MSP_CAW) "
strSQL = strSQL & " " & "INNER JOIN tblBunoOrg "
strSQL = strSQL & " " & "ON tblMUFiles.BUNO = tblBunoOrg.BUNO "
strSQL = strSQL & " " & "WHERE (((tblMSPCodes.SYSTEM) = '" & [Forms]![frm4_Export_dbx_save]![txtSelectSystem] & "') "
strSQL = strSQL & " " & "AND ((tblBunoOrg.Command)<>'STRICKEN'));"

Debug.Print strSQL

'Step 4 GOOD: Define my recordset (= results of query)

Set RS = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)

'Step 5 GOOD: Verify that are more than 0 records by counting. End of records = count of max records

intMaxCol = RS.Fields.Count

If RS.RecordCount > 0 Then
RS.MoveLast: RS.MoveFirst
intMaxrow = RS.RecordCount

'Step 6 GOOD: Create excel object and Open

Set xlapp = CreateObject("Excel.application")


'Step 7 GOOD: copy recordset to sheet 1 into 2nd row (leave row for column headers)

With xlapp
.Visible = True
.DisplayAlerts = False
Set xlwkbk = xlapp.Workbooks.Add
Set xlsheet = xlwkbk.Worksheets(1)
Set xlsheet2 = xlwkbk.Worksheets(2)


MsgBox ("enable excel before continuing")

With xlsheet
.Range(xlsheet.Cells(2, 1), .Cells(intMaxrow, intMaxCol)).CopyFromRecordset RS
End With

'Step 8 GOOD: Add column heading names to the spreadsheet
For i = 1 To RS.Fields.Count
xlapp.ActiveSheet.Cells(1, i).Value = RS.Fields(i - 1).Name
Next i
End With
End If


'step 9 GOOD: find the last row with data starting with rows in column A

With xlsheet
lastrow = xlsheet.Cells(xlsheet.Rows.Count, "A").End(xlUp).Row

'Step 10 GOOD: find the last column with data starting with row 1

lastcol = xlsheet.Cells(1, xlsheet.Columns.Count).End(xlToLeft).Column

End With

'Step 11 GOOD: Use Selected system as tab name
xlsheet.Name = "SYSTEM"


'Step 12 GOOD: find the range of the data (changed from ref xlsheets_data.cells)
Set rng1 = xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(lastrow, lastcol))

Sheets("sheet2").Name = "PIVOT"
Sheets("PIVOT").Select
Range("A1").Select

'Step 13 ARGHHHHHHHHHHH!!!!: create the pivot table
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveWorkbook.Sheets("SYSTEM").Range("rng1")) _
.CreatePivotTable _
Tabledestination:="", _
TableName:="PivotTable2", _
Defaultversion:=xlPivotTableVersion14


'Step 14 GOOD: Set the pivot table fields
FormatPvtMSP

'Step 15 GOOD: add another worksheet READ ME for additional comments
Worksheets.Add().Name = "READ ME"
Worksheets("READ ME").Cells(1, 1).Value = "Two roads diverged in a yellow"
Worksheets("READ ME").Cells(2, 1).Value = "And sorry I could not travel both"

xlwkbk.SaveAs FileName:=outputfilename
Debug.Print outputfilename

'Step 16 GOOD: close workbook and save changes
ActiveWorkbook.Close True


With xlapp
.DisplayAlerts = True
.ScreenUpdating = True
.Quit
End With

'Step 17 GOOD: Clean up (close anything opened, reset anything set)
RS.Close
Set RS = Nothing
Set xlwkbk = Nothing
Set xlapp = Nothing
Set xlsheet = Nothing
Set xlsheet2 = Nothing
Set rng1 = Nothing
Set pvtcache = Nothing
Set pvtTable = Nothing

MsgBox ("Done!")


End Sub