Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2354
  • Last Modified:

Pivot Table based on Query Table - Excel VBA

I generate the raw data for the pivot table using an ODBC connection.  The query is built dynamically based on values the user selects but I've simplified it in the code for confidentiality reasons.  

The raw data is on the worksheet "Water Data".  The pivot table is on the worksheet "Sheet4".  

ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh does not refresh the pivot table. I can refresh it manually but the row labels change.

A couple hours of research here and elsewhere haven't led to any success yet.  How can I do this with VBA?

Thanks,
--Caren


Sub GetData()

    ' Declare the QueryTable object
    Dim qtWater As QueryTable
    Dim strSQL As String
    
   strSQL = SELECT field1 FROM table1    

    ' Set up the connection string
    connString = "ODBC;DSN=MyDSN;UID=MyUID;PWD=MyPWD;Database=MyDB"

   'Clear previous query results
    Sheets("Water Data").Select
    Range("A9").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("A9").Select

    'Run the query and add the results to the spreadsheet starting at A8
    With ActiveSheet.QueryTables.Add(Connection:=connString, Destination:=Range("a8"), Sql:=strSQL)
        .Name = "qtWater"
        .RefreshStyle = xlOverwriteCells
        .Refresh
        RecCount = .ResultRange.Rows.Count  '# of rows in query table
        'msgbox reccount
    End With    
    
    ' Refresh the pivot table       
    Sheets("Sheet4").Select
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh
    

End Sub

Open in new window

0
CarenC
Asked:
CarenC
  • 8
  • 7
3 Solutions
 
CarenCAuthor Commented:
I forgot to add that since the query always returns a different row count I need to code that into the pivot table creation/refresh?
0
 
folderolCommented:
I suggest you stop adding the querytable each refresh.  Instead, you can write to the querytables(1).CommandText property to modify the query.

This has several advantages.  The querytable has a named range associated with the cell range in which the results are returned.  If your pivottable is using the same range as its datasource, it will automatically resize itself to the result range of the query when it refreshes.

The Query will overwrite itself, so you don't need to do the cleanup starting at line 12.

Be aware that the querytable must be the only object using this connection.  If create two querytables on the same connection, then you can't write to the .commandtext property.

If the query is a version 12 (2007) query then the .commandtext property is found at
listobjects(1).querytable.commandtext

else it is the same as in 2003
querytables(1).commandtext

Tom.
Sub GetData() 
 
    ' Declare the QueryTable object 
    Dim qtWater As QueryTable 
    Dim strSQL As String 
     
    strSQL = "SELECT field1 FROM table1"     
 
    Set qt = ListObjects("Table_1_Query").QueryTable
    qt.CommandText = strSQL
    qt.Refresh
    WorkSheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh 

End Sub

Open in new window

0
 
CarenCAuthor Commented:
This is my first time querying an external data source so I'm not real familiar with the commans.  

I pasted your code exact as is to see what happend.  I get the error message "Sub or Function not defined" with the word "ListObjects" highlighted.

I assume that I would change my Dim from "qtWater" to "qt" or change your code to "qtWater".
In your example what is "Table_1_Query" and how do I get this name?
Where and how is the connection string used?

Thank you for working with me on this.

--Caren
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
folderolCommented:
Sorry Caren,

I tested that code within a sheet module.  For a standard macro in a code module, the worksheet object must be specified for the listobject, and the correct name of the listobject must be inside the "" marks.  You can get the listobject name by clicking any cell in the table, and from the ribbon, click table tools Design, (if you don't have a "Table Tools Design" heading in the ribbon, then you don't have a listobject, the query is an Excel 11 version and is returning as a querytables object),
and on the left of the ribbon is a textbox with the table name.

Something like this

Sub GetData()  
 
    ' Declare the QueryTable object  
    Dim qtWater As QueryTable  
    Dim strSQL As String  
     
    strSQL = "SELECT field1 FROM table1"      
 
    Set qt = activesheet.ListObjects("Your_name_here").QueryTable
    qt.CommandText = strSQL
    qt.Refresh
    WorkSheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh  
 
End Sub

For a querytables object, the code is slightly different...

Sub GetData()  
 
    ' Declare the QueryTable object  
    Dim qtWater As QueryTable  
    Dim strSQL As String  
     
    strSQL = "SELECT field1 FROM table1"      
 
    Set qt = activesheet.QueryTables(1)
    qt.CommandText = strSQL
    qt.Refresh                   ' this line may be redundant and can be removed.
    WorkSheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh  

End Sub

the qt.Refresh of a querytables object may not be necessary, since ODBC connections will refresh automatically if the querytable's commandtext is changed.  On the other hand, I don't know if your query is using an ODBC connection.

Tom.
0
 
folderolCommented:
Actually, the qt.refresh almost certainly is unnecessary, as I see from your code above you are using an ODBC connection.  Test it for yourself, but I'm pretty sure it will refresh twice as the code is written, so you can take out the qt.refresh.
0
 
folderolCommented:
Sometimes I don't proofread!

Set qt =  
    should be
Set qtWater =
    and all other references to qt. must be changed to qtWater.
0
 
CarenCAuthor Commented:
1.  I am using an ODBC connection but if I take out qt.refresh there's no data returned/refresh. If I leave that line in it works fine. However, I will have to use ActiveSheet.QueryTables.Add(Connection:=connString, Destination:=Range("a8"), Sql:=strSQL) ... because some of my users use 2003 and some 2007.

2. The pivot table does not refresh and when I refresh it manually, the same data source range is used even though the query has returned a different number of rows.  I tried several ways but can't figure out how to dynamically set the datasource of the pivot table.

3. I have a lot of connections that have saved with my spreadsheet ... 75 so far. Where are those coming from?

4a. Is there a way to detect if the user has the proper ODBC connection set up?
  b. Is there a way to programmatically set up the ODBC connection for the user?  It doesn't have to be in the spreadsheet.  

I'm getting there slowly but surely. Thanks.
0
 
folderolCommented:
First off, the snippet attached here just fixes your existing code, it does not introduce the suggestions below.  Your existing code has two problems.... first,

Your code is adding querytables objects.  Clearing the result range does not necessarily remove the querytables object.  You should use
   querytables("qtWater").delete

...second,

The querytable adds a named range, and you label it with the line
   .Name = "qtWater"
so you might as well use it.  The snippet uses this named range's RefersTo property to make sure the pivottable covers the correct rows.

The snippet fixes both of these.

     
I would suggest you break this code into two macros, one to create / destroy the querytable, another to manage the refresh of it and the pivottable.  Since you use both 2003 and 2007, use the querytables code, not the listobjects code.  Your QueryTables.Add macro will create an object that this code will work in both versions.  The If ... Then ... will prevent the query refreshing twice as I previously explained, but allow you to keep the .refresh in case the user does not modify the command text.
As I stated previously,
   the pivottable will stay synced with the named range, so you won't have to include those lines of code, and
   the querytables will not be added over and over, so you won't have to maintain the cells in the result range anymove either.

Tom.


Sub GetData()  
    ' Declare the QueryTable object  
    Dim qtWater As QueryTable  
    Dim strSQL As String  
    strSQL = "SELECT field1 FROM table1"      
 
    Set qtWater = WorkSheets("Water Data").QueryTables(1)
    if qtWater.CommandText <> strSQL then
            qtWater.CommandText = strSQL
     else
            qtWater.Refresh
     Endif
    WorkSheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh  
End Sub




 
Sub CreateQuery() 
 
    ' Declare the QueryTable object 
    Dim qtWater As QueryTable 
    Dim strSQL As String 
    Dim nm As Name

   strSQL = SELECT field1 FROM table1     
 
    ' Set up the connection string 
    connString = "ODBC;DSN=MyDSN;UID=MyUID;PWD=MyPWD;Database=MyDB" 
 
   'Clear previous query results 
    Sheets("Water Data").Select 
    for each qtWater in worksheets("Water Data").querytables
         qtWater.delete
    next
    Range("A9").Select 
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 
    Selection.ClearContents 
    Range("A9").Select 
 
    'Run the query and add the results to the spreadsheet starting at A8 
    With ActiveSheet.QueryTables.Add(Connection:=connString, Destination:=Range("a8"), Sql:=strSQL) 
        .Name = "qtWater" 
        .RefreshStyle = xlOverwriteCells 
        .Refresh 
        RecCount = .ResultRange.Rows.Count  '# of rows in query table 
        'msgbox reccount 
    End With     
     
    ' Refresh the pivot table        
    Set nm = Worksheets("Water Data").Names("qtWater")

    Sheets("Sheet4").Select 
    Worksheets("Sheet4").Pivottables("PivotTable2").SourceData = nm.RefersTo
    Worksheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh 
 
End Sub

Open in new window

0
 
CarenCAuthor Commented:
Okay . . . I finally understand how it's supposed to work but I'm not clear about using the named range.

I get an error on this line
Set nm = Worksheets("Water Data").Names("qtWater")
The error is  "Run Time Error 1004: Application-defined or object -defined error"

Something isn't working right with the name property.  
I start off and have this 2 named ranges:
'SiteList!Query_from_MyODBC      =SiteList!$A$1:$A$504
'Water Data'!Query_from_MyODBC      ='Water Data'!#REF!
 
I run CreateQuery() and have this:
Water Data'!qtWater_1      ='Water Data'!$A$8
SiteList!Query_from_MyODBC      =SiteList!$A$1:$A$504
Water Data'!Query_from_MyODBC      ='Water Data'!#REF!

I can't figure out where this: 'Water Data'!Query_from_MyODBC      ='Water Data'!#REF! is coming from.
0
 
folderolCommented:
I have a bug based on the worksheet where the pivottable is found.  The referto property only works if the pivottable is on the same sheet as the sourcedata, which is not your case, so now my code only runs if I use the mid() function to trim off the "=" sign from the RefersToR1C1 property.
      pt.SourceData = Mid(nm.RefersToR1C1, 2, 255).

See the next to last line in this snippet.

As for the named ranges, it's an orphan, my guess.  It comes from deleting the usedrange like you were doing.  Before you run the CreateQuery() macro, go in and delete the named ranges from Water Data!

qtWater_1 is a duplicate, Excel is appending the _1 because qtWater might still exist, so cleaning up the names table will help.  I tested this in Excel 2003 and it ran smoothly.  One other thing, atWater is a worksheet name, not an application name, and you can see this in the names table because it has a sheet name on the right, whereas application names do not.

By the way, you clear the range starting at A9, but return the query starting at A8.  Shouldn't they both refer to A8?


Sub CreateQuery()  
  
    ' Declare the QueryTable object '  
    Dim qtWater As QueryTable  
    Dim strSQL As String  
    Dim nm As Name 
 
   strSQL = "SELECT field1 FROM table1"      
  
    ' Set up the connection string  '
    connString = "ODBC;DSN=MyDSN;UID=MyUID;PWD=MyPWD;Database=MyDB"  
  
   'Clear previous query results  '
    Sheets("Water Data").Select  
    for each qtWater in worksheets("Water Data").querytables 
         qtWater.delete 
    next 
    Range("A9").Select  
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select  
    Selection.ClearContents  
    Range("A9").Select  
  
    'Run the query and add the results to the spreadsheet starting at A8  '
    With ActiveSheet.QueryTables.Add(Connection:=connString, Destination:=Range("a8"), Sql:=strSQL)  
        .Name = "qtWater"  
        .RefreshStyle = xlOverwriteCells  
        .Refresh  
        RecCount = .ResultRange.Rows.Count  '# of rows in query table ' 
        'msgbox reccount'  
    End With      
      
    ' Refresh the pivot table'         
    Set nm = Worksheets("Water Data").Names("qtWater") 
 
    Sheets("Sheet4").Select  
    Worksheets("Sheet4").Pivottables("PivotTable2").SourceData = Mid(nm.RefersToR1C1, 2, 255) 
    Worksheets("Sheet4").PivotTables("PivotTable2").PivotCache.Refresh  
  
End Sub

Open in new window

0
 
CarenCAuthor Commented:
I had to add .Refresh BackgroundQuery:=False before
       Set nm = Worksheets("Water Data").Names("qtWater")
otherwise the reccount was 1 and the line above would error.

I added the 'clear previous query results' code but it isn't working properly.  The name is deleted from Name Manager but it's hidden somewhere because the next time the query runs qtWater_1 is created.  It works if I close the file and open it again but I need it to work any time the user runs a query as there are user selected variables in the query.

Hopefully this is the last issue to resolve.
0
 
folderolCommented:
I think you should take my suggestion and only run the
Sub Createquery()

once.  From then on, use the
Sub GetData()

macro.  This will stop all your problems.  If you don't or can't follow this suggestion, then try adding the lines

for each nm in worksheets("Water Data").names
     nm.delete
next



0
 
CarenCAuthor Commented:
Don't or can't ?  :)   Following your suggestions and copying your code just as you posted, GetData  just wouldn't work until I added these 2 lines
     qtWater.Refresh BackgroundQuery:=False
     qtWater.Refresh
And, until I added this line the pivot table would not refresh.
     ActiveSheet.PivotTables("WaterPivotTable").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:="qtWater", Version _
        :=xlPivotTableVersion12)

It seems to work now although I have to put in some code to detect if SubQuery has already run.
Can't thank you enough for sticking with me through this.
Sub GetData()  
  
    ' Declare the QueryTable object  
    Dim qtWater As QueryTable  
    Dim strSQL As String  
      
    strSQL = "SELECT field1 FROM table1"        

Set qtWater = Worksheets("Water Data").QueryTables(1)
    If qtWater.CommandText <> strSQL Then
            qtWater.CommandText = strSQL
            qtWater.Refresh BackgroundQuery:=False	' doesn't work without this line
            qtWater.Refresh				' doesn't work without this line
    Else
            qtWater.Refresh
    End If
    
    Sheets("Water Report").Select
    ' Refresh the data source of the pivot table 	
    ' pivot table doesn't refresh without the next line
    ActiveSheet.PivotTables("WaterPivotTable").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:="qtWater", Version _
        :=xlPivotTableVersion12)
    
    Worksheets("Water Report").PivotTables("WaterPivotTable").PivotCache.Refresh

End Sub

Open in new window

0
 
folderolCommented:
CarenC,
I don't know if its on my end, but I am not being notified when you post to this thread.  Some EE threads are notifying me, and this one says I'm monitoring it.... oh well.

I'm happy its working, I can't even guess why your code is different from my test workbook, but I guess I didn't get all the test conditions right somewhere.

Good luck with the water data!
0
 
CarenCAuthor Commented:
Thanks again!  Would give you 1,000 points if I could.
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 8
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now