Excel Forum

Code: Select all

Sub CreatePivotTable()
'PURPOSE: Creates a brand new Pivot table on a new worksheet from data in the ActiveSheet
'Source: www.TheSpreadsheetGuru.com
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

strFile = "D:/test Query.xlsx"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = [D1] '& " Union " & [D2]
rs.Open strSQL, cn

Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As Object

'Determine the data range you want to pivot
  SrcData = CopyFromRecordset rs
  
'Create a new worksheet
  Set sht = Sheets.Add

'Where do you want Pivot Table to start?
  StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)

'Create Pivot Cache from Source Data
  Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SrcData)

'Create Pivot table from Pivot Cache
  Set pvt = pvtCache.CreatePivotTable( _
    TableDestination:=StartPvt, _
    TableName:="PivotTable1")

End Sub

Code: Select all

Sub CreatePivotTable2()

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

Dim splitsql As Variant

strFile = "D:/test Query.xlsx"
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = [H1] '& " Union " & [D2]
rs.Open strSQL, cn


splitsql = strSQL

With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
.Connection = "OLEDB;" & cn
.CommandType = xlCmdSql
.CommandText = splitsql
.CreatePivotTable TableDestination:= _
"Sheet1!R1C14", TableName:="PivotTable", _
DefaultVersion:=xlPivotTableVersion10
End With

End Sub