Problem Creating an Excel Pivot Table in VB6 2

[aine]

Hi I am having problems creating a Pivot Table from VB code. My Code below runs a database query and returns the results to a Recordset,
It then puts the contents of the recordset into an excel worksheet (Sheet1), this works fine even though i have a feeling I went a roundabout method of doing it.

I Now Want to take the used Range in Sheet1 and create a pivot Table in Sheet2. I Have Tried See below, but I am getting the following errors:

:Reference not valid
:Application Defined or Object Defined error

I would greatly appriciate if anyone could Tell me Where I am going wrong. Code Is working Up to the Point Where I try To Create A pivot table.


***CODE***

Private PGDB As Database
Private rs As Recordset
Dim sPath As String
Dim strXPath As String
Dim strSQL As String
Dim xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim xlSht1 As Excel.Worksheet
Dim xlSht2 As Excel.Worksheet
Dim PTable As Excel.PivotTable
Dim PCache As Excel.PivotCache
Dim PField As Excel.PivotField

Private Sub CmdEnter_Click()
On Error GoTo Err_CmdEnter_Click


'Path to Access Database
sPath = "C:\Databases\Database1.mdb"

'Path to Excel File
strXPath = "C:\Reports\TEST.xls"


strSQL = "SELECT CUSTOMERS.[Customer_Account No], CUSTOMERS.[Customer_Name], CUSTOMERS.[Customer_Address2], CUSTOMERS.[Customer_Address3], CUSTOMERS.[Customer_Address_4], SALES.Occasion, SALES.Title, SALES.[Price_Band], Sum(SALES.Invoice_Quantity) As QTY, Sum(SALES.Gross_Goods_Value) As Gross " & _
"FROM CUSTOMERS INNER JOIN SALES ON CUSTOMERS.[Customer_Account No]=SALES.[Customer_Account No]" & _
"WHERE(((CUSTOMERS.[Customer_Account No])= """ & CboNumber & """ ) And ((SALES.Invoice_Date) Between #" & TxtFrom & "# And #" & TxtTo & "#))" & _
"GROUP BY CUSTOMERS.[Customer_Account No], CUSTOMERS.Customer_Name, CUSTOMERS.Customer_Address2, CUSTOMERS.Customer_Address3, CUSTOMERS.Customer_Address_4, SALES.Title, SALES.Price_Band, SALES.Occasion;"


'Open database, Run Query and return results to recordset
Set PGDB = OpenDatabase(sPath)
Set rs = PGDB.OpenRecordset(strSQL)


'Open Excel
Set xlApp = New Excel.Application
Set xlWkb = xlApp.Workbooks.Open(strXPath)
Set xlSht1 = xlWkb.Worksheets("Sheet1" )
Set xlSht2 = xlWkb.Worksheets("Sheet2" )

xlSht1.Activate


'Enter column headingings in excel file
Range("A1" ) = "Customer_Account No"
Range("B1" ) = "Customer_Name"
Range("C1" ) = "Customer_Address2"
Range("D1" ) = "Customer_Address3"
Range("E1" ) = "Customer_Address_4"
Range("F1" ) = "Occasion"
Range("G1" ) = "Title"
Range("H1" ) = "Price_Band"
Range("I1" ) = "QTY"
Range("J1" ) = "Gross"


'Enter data from recordset into excel file,
'this is working, but if anyone knows a better way

Dim intI As Integer
Dim strCell As String
intI = 2

Do While Not rs.EOF
strCell = "" & intI & ""
Range("A" & strCell) = rs.Fields("Customer_Account No" )
Range("B" & strCell) = rs.Fields("Customer_Name" )
Range("C" & strCell) = rs.Fields("Customer_Address2" )
Range("D" & strCell) = rs.Fields("Customer_Address3" )
Range("E" & strCell) = rs.Fields("Customer_Address_4" )
Range("F" & strCell) = rs.Fields("Occasion" )
Range("G" & strCell) = rs.Fields("Title" )
Range("H" & strCell) = rs.Fields("Price_Band" )
Range("I" & strCell) = rs.Fields("QTY" )
Range("J" & strCell) = rs.Fields("Gross" )

rs.MoveNext
intI = intI + 1
Loop

'Close Recordset and Database
rs.Close
PGDB.Close

'Find the last Row in the excel worksheet
Dim LastRow As Integer

If xlApp.WorksheetFunction.CountA(Worksheets("Sheet1" ).Cells) = 0 Then
LastRow = 1
Else
LastRow = Worksheets("Sheet1" ).UsedRange.Rows.Count + Worksheets("Sheet1" ).UsedRange.Row

While Application.WorksheetFunction.CountA(Worksheets("Sheet1" ).Rows(LastRow)) = 0
LastRow = LastRow - 1
Wend
End If


'Use LastRow to find range for pivot table
Dim strRange As String
strRange = "A1J1:A" & "" & LastRow & "" & "J" & "" & LastRow & ""


'Build Pivot Table, the code is working up to here
'I am getting a "Reference Not Valid" Error and
'A Application Defined and Object Defined error

PCache = xlWkb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=strRange).CreatePivotTable(TableDestination:=xlSht2.Cells(5, 1), TableName:="Sales Analysis" )
PTable = xlSht2.PivotTable("Sales Analysis" )

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("Occasion" )
PField.Orientation = xlRowField
End With

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("Title" )
PField.Orientation = xlRowField
End With

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("Price_Band" )
PField.Orientation = xlColumnField
End With

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("Customer_Account No" )
PField.Orientation = xlPageField
End With

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("QTY" )
PField.Orientation = xlDataField
End With

With xlSht2.PivotTables("Sales Analysis" )
PField = PTable.PivotFields("Gross" )
PField.Orientation = xlDataField
End With


'Open excel to view pivot table
xlSht2.Activate
xlApp.Visible = True



Exit_CmdEnter_Click:
Exit Sub

Err_CmdEnter_Click:
MsgBox Err.Description
Resume Exit_CmdEnter_Click

End Sub

***END CODE***

 

[xlbo]

Coupla points that stand out but do not relate to the immediate question - your lastRow should be defined as LONG not integer - integer only goes up to apprx 35000
This also seems a VERY long winded way of getting lastrow:
If xlApp.WorksheetFunction.CountA(Worksheets("Sheet1" ).Cells) = 0 Then
LastRow = 1
Else
LastRow = Worksheets("Sheet1" ).UsedRange.Rows.Count + Worksheets("Sheet1" ).UsedRange.Row

While Application.WorksheetFunction.CountA(Worksheets("Sheet1" ).Rows(LastRow)) = 0
LastRow = LastRow - 1
Wend
End If

You should be able to use
lastRow = sheets("Sheet1&quot.usedrange.rows.count
OR
lastrow = sheets("Sheet1&quot.range("A65536&quot.end(xlup).row

also....are you aware that you can create a pivot table based on external data???
Rather than bringing the data into excel, you can use the pivot table wizard to get the data from an external database

Record yourself doing this and you shouldn't need to mess around with lastrow - the code generated while recording should not need to be changed (unless your query changes...)

Unfortunately, I am still working on excel 97 which uses the pivotwizard method rather than the pivotcaches method so I can't comment on the structure of how you are building the pivottable

Rgds
Geoff
"Some cause happiness wherever they go; others whenever they go."
-Oscar Wilde

 

[aine]

Thanks xlbo

Both tips where useful and the pivot table is now opening.

I unfortunetly can't use the get external data option in excel as My query needs data from my vbform

I didn't know about recording macros so this is a great tip to save me time in future

Thanks again

aine

 

[xlbo]

Cool - as I said, I can't comment on the pivot code itself but I thought that it might be something to do with your definition of lastrow

Rgds
Geoff
"Some cause happiness wherever they go; others whenever they go."
-Oscar Wilde

 

[VikalpJain]

Hi Aine,
I also have a similar requirement of creating a Pivot table from a excel sheet.
I tried the code given by you above with my database and I am also getting these errors :
"Reference Not Valid" Error and
A Application Defined and Object Defined error

Can you please tell me how you got past these errors ??

Also does anyone has any sample code which can tell how to use Pivot tables using a recordset ?
Basically my query to fetch the data for Pivot report will be changing dynamically. But the pivot table always runs the query which was supplied when the report was created first time. Can anyone tell how do I change my query dynamically ?
The code I am using to create pivot table is :


Private Sub Command1_Click()


Dim objExcel As Excel.Application
Dim objWorkBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim objRange As Excel.Range

Dim cnnConn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim cmdCommand As ADODB.Command


Set objExcel = New Excel.Application
With objExcel
.Visible = True
' Set objWorkBook = .Workbooks.Add
Set objWorkBook = .Workbooks.Open("C:\TestPivot.xls&quot
End With
Set objSheet = objWorkBook.Worksheets(1)


Set cnnConn = New ADODB.Connection
With cnnConn
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0"
.CursorLocation = adUseClient
.Open "C:\MyData.mdb"
End With

' Set the command text.
Set cmdCommand = New ADODB.Command
Set cmdCommand.ActiveConnection = cnnConn
With cmdCommand
.CommandText = "Select * From examples"
.CommandType = adCmdText
.Execute
End With

Dim strSql As String

'This query is going to change dynamically
strSql = "Select * From examples"

' Open the recordset.
Set rstRecordset = New ADODB.Recordset

Set rstRecordset.ActiveConnection = cnnConn
rstRecordset.Open cmdCommand

' Create a PivotTable cache and report.
Set objPivotCache = objWorkBook.PivotCaches.Add( _
SourceType:=xlExternal)
Set objPivotCache.Recordset = rstRecordset
With objPivotCache
'This is where I get "Object variable or with block not set" error
Set objRange = objWorkBook.ActiveSheet.Range("A3&quot
.CreatePivotTable TableDestination:=objRange, _
TableName:="PivotTable1"

End With
' Close the connections and clean up.
cnnConn.Close
Set cmdCommand = Nothing
Set rstRecordset = Nothing
Set cnnConn = Nothing

End Sub

 

[aine]

Hi VikalpJain

I don't know if I Can be much Help to you as I couldn't find a way to create the pivot table direct from the recordset, wish I could. I had To print the record set into a worksheet first then create the pivot table from the columns. This is my final code for creating a pivot table and it works hope it helps you.

Aine

//code
LastRow = Sheets("Sheet1&quot.UsedRange.Rows.Count
strRange = "Sheet1!R1C1:R" & "" & LastRow & "" & "C12"

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= strRange).CreatePivotTable_ TableDestination:="", TableName:= _
"SalesAnalysis", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("SalesAnalysis&quot.AddFields RowFields:=Array("Occasion", _
"Title", "Data&quot, ColumnFields:="Price_Band", PageFields:=Array( _
"Customer_Address6", "Customer_Address5", "Customer_Address_4", "Customer_Address3", _
"Customer_Address2", "Customer_Name", "Customer_Account No&quot
With ActiveSheet.PivotTables("SalesAnalysis&quot.PivotFields("QTY&quot
.Orientation = xlDataField
.Position = 1
End With
With ActiveSheet.PivotTables("SalesAnalysis&quot.PivotFields("Gross&quot
.Orientation = xlDataField
.NumberFormat = "[$€-2] #,##0.00"
End With
ActiveWorkbook.ShowPivotTableFieldList = False

//end of code

 

[VikalpJain]

Thanks Aine,
This part works fine.Now the problem is it takes too long to populate excel sheet from SQL server. We have got abt 100,000+ records in our table....to populate these records in excel sheet it takes almost an hour !!!!
Can you pls tell me what method you used to populate excel sheet ??
Thanks again,
Vikalp

 

[aine]

Sorry Vikalp

I Have To populate every cell individually as well, but luckally none of my reports have that many records. I seems that there should be an easier way, such as creating the pivot table direct from the recordset but I haven't been able to do it yet. let me know if you figure out a way.

By the way I had to change my Above Code, because although everything was being created okay in excel it was hanging on closing. After a lot of trial and error I figured out that I couldn't use ActiveSheet, I had To reference every cell, range etc with the names I had Given them when opening, Such as xlApp, xlWkb and xlSht.

I included the code below in case you had similar problems.

strRange = "Sheet2!R1C1:R" & "" & LastRow & "" & "C12"

xlWkb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
strRange).CreatePivotTable TableDestination:="[CusSalesAnalysisReports.xls]Sheet1!R3C1", TableName:= _
"SalesAnalysis", DefaultVersion:=xlPivotTableVersion10
xlSht.Activate
xlSht.PivotTables("SalesAnalysis&quot.AddFields RowFields:=Array("Occasion", _
"Title", "Data&quot, ColumnFields:="Price_Band", PageFields:=Array( _
"Customer_Address6", "Customer_Address5", "Customer_Address_4", "Customer_Address3", _
"Customer_Address2", "Customer_Name", "Customer_Account No&quot

With xlSht.PivotTables("SalesAnalysis&quot.PivotFields("QTY&quot
.Orientation = xlDataField
.Position = 1
End With
With xlSht.PivotTables("SalesAnalysis&quot.PivotFields("Gross&quot
.Orientation = xlDataField
.NumberFormat = "[$€-2] #,##0.00"
End With
xlWkb.ShowPivotTableFieldList = False

 

[SkipVought]

Hi,

Once you have retrieved your recordset, getting the headings and data into a sheet is a piece of cake...

'your headings
For iCols = 0 to rs.Fields.Count - 1
    ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
'your data
ws.Range(ws.Cells(1, 1),  _
    ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs

You Do NOT need to define the Last Row.
The range for the Pivot Table is just...

Set pvtRange = ActiveSheet.Cells(1,1).CurrentRegion

As Geoff stated, recording the creation of a pivot table in excel is the way to begin.


Hope this helps

Skip,
Skip@TheOfficeExperts.com

http://www.TheOfficeExperts.com

 

[aine]

Thanks Geoff

Had just found the copy from recordset bit elsewhere but I Was still manually entering the headings.

Aine

 

[aine]

Sorry SkipVought
Just Called you Geoff misread post, Thanks Aine

 

[VikalpJain]

Thanks SkipVought,
CopyFromRecordset method works really fast. I was earlier planning to use BCP command from shell. But it was causing too many problems regarding formatting etc...
Now I have changed my code to use CopyFromRecordset and it works really well.
Thanks everyone, it was really helpful.
Vikalp