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

silentbuddha

Board Regular
Joined
Mar 1, 2008
Messages
112
Hi,

many threads have been created..but i figure nothing wrong with rehashing some old stuff....

I hope it may help those new to working with VBA and pvitocache, pivottable, pivotfield etc....

Feel free to add corrections to make the code work more efficiently :)

***************** code *******************

Private Sub getRetentionDetails2(date1 As String, date2 As String)
'This was set up using Microsoft ActiveX Data Components version 2.8
'this procedure will use ADO to connect to sql server 2005
'it will then paste the ADO recorset onto a worksheet
'it will then use the data from the worksheet to create pivot table



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
'since the data that we are using to feed the objPvtCache is from the current activeworksheet, the SourceType must be "xlDatabase"
Set objPvtCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=ws.UsedRange)

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

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
 

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,580
Messages
5,770,972
Members
425,654
Latest member
Kotika

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top