Excel 2003 - VBA - use ADO recordset & create pivot table

[silentbuddha]

Hi,

I have succesffuly imported data from my ADO connection to my worksheet. However, i would like to know

1 - how do I create a pivot table with my recordset object

Thanks in advance

 

[silentbuddha]

Hi...this is what I have so far...

'Create a PivotCache object
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)


'Assign your recordset to the objPivotCache object
Set objPivotCache.Recordset = rs

'Create pivot table
With objPivotCache
.CreatePivotTable TableDestination:=ws.Range("Z10")

'Use this line of code instead if you want to specify a tablename for the pivot table
'.CreatePivotTable TableDestination:=ws.Range("Z10"), TableName:="ABCDEFG"
End With

I know that the first field item in my pivot item list is WEEK. I would like to know how I can

1 - place the first field item in the column section
2 - place the rest of the field items in the data section

Thanks !

 

[silentbuddha]

Hi....I dont know if I am the right path....

'Initiate PivotCache object to accept external data
Set objPivotCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)


'Assign the recordset to PivotCache object
Set objPivotCache.Recordset = rs

'Create pivot table
With objPivotCache
.CreatePivotTable TableDestination:=ws.Range("Z10")
'Use this line of code instead if you want to specify a tablename for the pivot table
'.CreatePivotTable TableDestination:=ws.Range("Z10"), TableName:="ABCDEFG"
End With

'Place the pivot field items in table
'Place the field item "Week" into the column section

With objPivotCache.PivotTables <--- code is faulty starting from this point

With .PivotFields

For i = 1 To .PivotFields.Count

If .PivotFields(i).Name = "Week" Then

.Orientation = xlColumnField

Else

.Orientation = xlDataField

End If

Next

End With

End With

Thanks in advance...

 

[silentbuddha]

Here is my solution....However, I have encountered another issue whereby when the pivot table is created,

1 - all the datafields set to " Count of " instead of "SUM of "
2 - when I manually go to change one of the datafields items from "Count of " to "Sum of " the valuea are 0.00

************* here is my code ***********

Private Sub getRetentionDetails(date1 As String, date2 As String)
'This was set up using Microsoft ActiveX Data Components version 2.8

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Dim strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rangeStart As Range
Dim pvtTable As PivotTable
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim objPvtCache As PivotCache

Dim iCol As Integer
Dim i As Integer

Const CONN_STRING As String = "Provider=SQLNCLI;Server=sql.XYZreporting;Database=Business_Analysis;Trusted_Connection=yes;HDR=yes"";"

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("RETENTION_DETAILS")

With ws

.Cells.Clear
.Cells.ClearContents
.Cells.ClearFormats

Set rangeStart = .Range("A2")

End With

strSQL = "exec PRG_Consolidated_KPI_RetentionDetails " & "'" & date1 & "'" & " , " & "'" & date2 & "'"

'Create the ADO connection object
Set conn = New ADODB.Connection

'Apply some settings to the ADO connection object
'Open the connection to the database : .Open CONN_STRING
'Store the result in rs recordset object : Set rs = .Execute(strSQL)
With conn
.CursorLocation = adUseClient
.Open CONN_STRING
.CommandTimeout = 0
Set rs = .Execute(strSQL)
End With


'Apply the rs fieldnames ( column headers ) into Worksheets("RETENTION_DETAILS")
iCol = 1
For Each fld In rs.Fields

MsgBox "column # " & iCol & " fieldname is : " & fld.Name

ws.Cells(1, iCol).Value = fld.Name
iCol = iCol + 1
Next

'Paste the dataportion of the recordset into Worksheets("RETENTION_DETAILS")
rangeStart.CopyFromRecordset rs

'Correct cell with values stored as text on the Worksheets("RETENTION_DETAILS")
With ws.UsedRange
.Value = .Value
End With


'Initiate PivotCache object to accept external data
Set objPvtCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)


'Assign the recordset 'rs' to PivotCache object
Set objPvtCache.Recordset = rs

'Assign the objPvtCache to pvtTable objectCreate the pivot table
Set pvtTable = objPvtCache.CreatePivotTable(TableDestination:=ws.Range("Z10"), TableName:="RETENTION_DETAILS")

'Place the pivot field items in table
'Place the field item "Week" into the column section

With pvtTable

For Each pvtField In .PivotFields

If pvtField.Name = "Week" Then

MsgBox "the first pivot field is " & pvtField.Name
.AddFields ColumnFields:=pvtField.Name
pvtField.Orientation = xlColumnField
Else

MsgBox "the next pivot field is " & pvtField.Name
.AddDataField pvtField

End If

Next

End With

'cleanup and close connection
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Set fld = Nothing
Set rangeStart = Nothing

End Sub

 

[RoryA]

You will get Count if your fields are text (which would also explain why the sum is 0).

 

[silentbuddha]

Hi Rorya,

Thanks...how do I assure that my vba recordset object maintains the same datatype after executing my sql statement ???

Thank

 

[RoryA]

I don't know how you are creating your recordset, but whatever you are doing is returning a text value, not a numeric one. I can't say whether that is down to the query or the table structure.

 

[silentbuddha]

Hi,

would anyone know how do I assure that my vba recordset object maintains the same datatype after executing my sql statement

The issues occurs when I pass my ado recordset to the PivotCache object and then use the PivotCache object to create the pivot table, all the data is converted text

Thanks

 

[RoryA]

No-one is going to know that unless you tell us how you are creating it.

 

[silentbuddha]

Hi Rorya,

Thanks for being patient with me.....In the previous posts...I had pasted my entire code with comments that would explain how I am creating the ADO recordset object and how I pass that ado recordset to the PivotCache object...etc....

However, your 2nd to last post about verifying the sql qry got me thinking and i went back to my sql stored procedure and found that I was formatting the results as text....LOL...in the end I just remove some sql code that doing the formatting

************* HERE IS MY FINAL RESULT *************

Purpose : will create an ADO connection to SQL Server 2005.
will take the ADO recordset and paste it to a specified worksheet
will take the ADO recordset and create a pivot table in same specified worksheet

***********************************************

Private Sub getRetentionDetails(date1 As String, date2 As String)
'This was set up using Microsoft ActiveX Data Components version 2.8

Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Dim strSQL As String
Dim wb As Workbook
Dim ws As Worksheet
Dim rangeStart As Range
Dim pvtTable As PivotTable
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim objPvtCache As PivotCache

Dim iCol As Integer
Dim i As Integer

Const CONN_STRING As String = "Provider=SQLNCLI;Server=sql.XYZreporting;Database=Business_Analysis;Trusted_Connection=yes;HDR=yes"";"

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("RETENTION_DETAILS")

With ws

.Cells.Clear
.Cells.ClearContents
.Cells.ClearFormats

Set rangeStart = .Range("A2")

End With

strSQL = "exec PRG_Consolidated_KPI_RetentionDetails " & "'" & date1 & "'" & " , " & "'" & date2 & "'"

'Create the ADO connection object
Set conn = New ADODB.Connection

'Apply some settings to the ADO connection object
'Open the connection to the database : .Open CONN_STRING
'Store the result in rs recordset object : Set rs = .Execute(strSQL)
With conn
.CursorLocation = adUseClient
.Open CONN_STRING
.CommandTimeout = 0
Set rs = .Execute(strSQL)
End With


'Apply the rs fieldnames ( column headers ) into Worksheets("RETENTION_DETAILS")
iCol = 1
For Each fld In rs.Fields

MsgBox "column # " & iCol & " fieldname is : " & fld.Name

ws.Cells(1, iCol).Value = fld.Name
iCol = iCol + 1
Next

'Paste the dataportion of the recordset into Worksheets("RETENTION_DETAILS")
rangeStart.CopyFromRecordset rs

'Correct cell with values stored as text on the Worksheets("RETENTION_DETAILS")
With ws.UsedRange
.Value = .Value
End With


'Initiate PivotCache object to accept external data
Set objPvtCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)


'Assign the recordset 'rs' to PivotCache object
Set objPvtCache.Recordset = rs

'Assign the objPvtCache to pvtTable objectCreate the pivot table
Set pvtTable = objPvtCache.CreatePivotTable(TableDestination:=ws.Range("Z10"), TableName:="RETENTION_DETAILS")

'Place the pivot field items in table
'Place the field item "Week" into the column section

With pvtTable

For Each pvtField In .PivotFields

If pvtField.Name = "Week" Then

MsgBox "the first pivot field is " & pvtField.Name
.AddFields ColumnFields:=pvtField.Name
pvtField.Orientation = xlColumnField
Else

MsgBox "the next pivot field is " & pvtField.Name
.AddDataField pvtField

End If

Next

End With

'cleanup and close connection
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Set fld = Nothing
Set rangeStart = Nothing
Set objPvtCache = Nothing

End Sub