Pivot Table Help

Option Explicit
Const PIVOTNAME = "TestPivot"
Dim strFileExt As String
Dim lngFileFormat As Long




'
Sub CreateConnection()
Dim PT As PivotTable
Dim PC As PivotCache
Dim strFile As String
Dim strFileTemp As String
Dim strPath As String
Dim arrSheets As Variant
Dim strSQL As String
Dim strCon As String
Dim i As Long


' Sheets to consolidate
'*****************************************************************************
arrSheets = Array("System 1", "System 2", "System 3", "System 4")
'*****************************************************************************


If Val(Application.Version) > 11 Then
DeleteConnections_12
CheckFileFormat_12
Else
strFileExt = ".xls"
lngFileFormat = xlNormal
End If


Application.ScreenUpdating = False
With ThisWorkbook
strPath = .Path
strFile = .FullName
strFileTemp = strPath & "\DBtemp" & Format(Now, "yyyymmddhhmmss") & strFileExt
ActiveSheet.Cells.Clear
.Worksheets(arrSheets).Copy
End With


With ActiveWorkbook
.SaveAs strFileTemp, lngFileFormat
.Close
End With


For i = LBound(arrSheets) To UBound(arrSheets)
If arrSheets(i) <> ActiveSheet.Name Then
If strSQL = "" Then
strSQL = "SELECT * FROM [" & arrSheets(i) & "$]"
Else
strSQL = strSQL & " UNION ALL SELECT * FROM [" & arrSheets(i) & "$]"
End If
End If
Next i


strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & strFileTemp & ";" & _
"DefaultDir=" & strPath & ";" & _
"DriverId=790;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"


Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)


With PC
.Connection = strCon
.CommandType = xlCmdSql
.CommandText = strSQL
Set PT = .CreatePivotTable(TableDestination:=ActiveSheet.Range("A1"))
PT.Name = "TestPivot"
End With


With PT.PivotCache
.Connection = Replace(strCon, strFileTemp, strFile)
End With


'Clean up
Kill strFileTemp
Set PT = Nothing
Set PC = Nothing


End Sub




Sub ReestablishConnection()
Dim strFile As String
Dim strPath As String
Dim strCon As String


With ThisWorkbook
strPath = .Path
strFile = .FullName


strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & strFile & ";" & _
"DefaultDir=" & strPath & ";" & _
"DriverId=790;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"


With .Worksheets("Sheet1")
If .PivotTables.Count > 0 Then .PivotTables(PIVOTNAME).PivotCache.Connection = strCon
End With
End With
End Sub




Private Sub DeleteConnections_12()
Dim con
Dim PT As PivotTable
' This line won't work and wouldn't be necessary
' in the versions older than 2007
'*****************************************************************************
On Error Resume Next
With ThisWorkbook
Set PT = .Worksheets("Pivot").PivotTables(PIVOTNAME)
For Each con In .Connections
If con.ODBCConnection.Connection = PT.PivotCache.Connection _
And con.ODBCConnection.CommandText = PT.PivotCache.CommandText Then
con.Delete
End If
Next con
End With
On Error GoTo 0
'*****************************************************************************
End Sub




Sub CheckFileFormat_12()
With ThisWorkbook
Select Case .FileFormat
Case 51: strFileExt = ".xlsx": lngFileFormat = 51
Case 52:
If .HasVBProject Then
strFileExt = ".xlsm": lngFileFormat = 52
Else
strFileExt = ".xlsx": lngFileFormat = 51
End If
Case 56: strFileExt = ".xls": lngFileFormat = 56
Case Else: strFileExt = ".xlsb": lngFileFormat = 50
End Select
End With
End Sub




Sub SamplePivot()
Dim PT As PivotTable


CreateConnection
Set PT = ThisWorkbook.Worksheets("Sheet1").PivotTables(PIVOTNAME)


With PT


With .PivotFields(11) 'Material or Spec
.Orientation = xlRowField
.Position = 1
End With


With .PivotFields(10) 'Description
.Orientation = xlRowField
.Position = 2
End With


With .PivotFields(8) 'Size 1
.Orientation = xlRowField
.Position = 3
End With


With .PivotFields(9) 'Size 2
.Orientation = xlRowField
.Position = 4
End With


With .PivotFields(5) 'System
.Orientation = xlPageField
.Position = 1
End With
With .PivotFields(26) 'Total Qty's
.Orientation = xlColumnField
.Position = 1
End With
End With


'Clean up
Set PT = Nothing
Application.ScreenUpdating = True
End Sub​