Loop code - source for query

[scubadiver007]

I have this code which loops through 55 records. How can I use the "code" field as the source for a query which I then export to a spreadsheet using a module?

Dim rst As DAO.Recordset
Dim db As DAO.Database
dim strsql as string
Set db = CurrentDb()
'Change this to your SQL or to the name of a saved query
Set rst = db.OpenRecordset("Select code from tble_practice;")
With rst
' Very important to avoid errors if no records are returned
If Not (.EOF And .BOF) Then
'movefirst isn't strictly necessary - but just in case
.MoveFirst
Do Until .EOF
'do something with record
MsgBox !code
.MoveNext
Loop
End If
.Close
End With
Set rst = Nothing
Set db = Nothing

 

[GregRun]

Set rst = db.OpenRecordset("SELECT " & Me.Code & " FROM tble_practice")

 

[scubadiver007]

The code is for a button on a menu (so it contains no data).

The source query is a crosstab which needs to be filtered (which I want to do within the VBA loop) and this is joined to another table with an outerjoin. It is this second query that needs to be exported to Excel

To export the query I am using the "SendTQ2XLWbSheet" code in this thread:

http://www.access-programmers.co.uk/forums/showthread.php?t=209343

Either that or I can export all the data to Excel and then run a VBA code from Excel (but it would be good to learn something new! )

 

[scubadiver007]

I have spent all afternoon trying to work this through but having no joy. I am experimenting with code at the moment

Private Sub Command37_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim Kcode As String
Dim SQLcode As String
Dim qryDef As QueryDef
Set db = CurrentDb()
'Change this to your SQL or to the name of a saved query
Set rst = db.OpenRecordset("SELECT Code FROM tble_practice")
With rst
' Very important to avoid errors if no records are returned
If Not (.EOF And .BOF) Then
'movefirst isn't strictly necessary - but just in case
.MoveFirst
Do Until .EOF
'do something with record
Kcode = !Code
SQLcode = "select * from dbo_ES_factbase where gppracticecode = '" & Kcode & "';"
Set qryDef = dbs.CreateQueryDef("qwerty", SQLcode)
DoCmd.OpenQuery "qwerty"
.MoveNext
Loop
End If
.Close
End With
Set rst = Nothing
Set db = Nothing

End Sub

 

[GregRun]

I can see you have a typo in here. You reference dbs.CreateQueryDef but your database object is db, not dbs.

Sorry, I am having a difficult time following what you are trying to do here... Tell me if this is correct:

You have a table with some data in it.
You want to push a button on a form and export that data to Excel.
You have a table called tble_practice with a field named "Code"
I'm assuming "Code" here means some kind of alphanumeric code not VBA or SQL Code.

I don't have any real experience working with Crosstab Queries (because they're often not actually called for). I'm confused about what you're trying to accomplish here. Why are you making a new querydef for every record in your table? Maybe you could just tell me in plain english what your data is and what your query is supposed to do with that data.

Exporting data to excel is something you DEFINITELY should learn to do as it's much easier for you and the user and it's not that hard to accomplish. I glanced at the link you provided and it looks ok to me. I have my own code for doing this that I copy and paste into just about every database I create.

 

[scubadiver007]

Data is collected on a quarterly basis for which payments need to be calculated.

Before the payments are processed, each doctor surgery will receive a spreadsheet containing the data they submitted and the payments they will receive for them to agree.

I have a master spreadsheet which needs to be populated with data, which I have attached. I want to export the data from a query into the spreadsheet for each doctors surgery (so there will be 55 spreadsheets, one for each surgery).

The source query is a crosstab (at the moment is filtered for practice K81002). I will change the field name from "code" to something more appropriate.

"TRANSFORM Sum(PAYMENTS_calcs.Activity) AS SumOfActivity " & _
"SELECT PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
"FROM PAYMENTS_calcs " & _
"WHERE (((PAYMENTS_calcs.Code)="K81002") AND ((PAYMENTS_calcs.Activity)>0)) " & _
"GROUP BY PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
"ORDER BY PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
"PIVOT Left([Quartercode],2) In ("Q1","Q2","Q3","Q4"); " & _

Because not every practice will provide all the same services I need to ensure the data is being entered into the correct cells in the spreadsheet so I have a query with an outer join to a list of numbers in a table. Each number in the table equates to the row number in the spreadsheet. It is this query I need to export.

SELECT Tble_statementno.ID_Statement, ACTIVITY_src.Q1, ACTIVITY_src.Q2, ACTIVITY_src.Q3, ACTIVITY_src.Q4
FROM Tble_statementno LEFT JOIN ACTIVITY_src ON Tble_statementno.ID_Statement = ACTIVITY_src.ID_Statement;

I have a function that will determine the top left cell for the data is D6 which works fine.

I have been able to export data into separate sheets from a form containing data but I would rather do it using a button on the menu if it is possible.

What I am trying to get at is how can I used the practice code extracted in the loop to act as the source for the crosstab query.

 

[GregRun]

I would set up a Sub to export your excel just for organization's sake. Here's the code you need:

Option Compare Database
Option Explicit

Dim xlApp As Excel.Application

Private Sub btnExcel_Click()
    Dim db As DAO.Database
    Dim rstTable As DAO.Recordset
    Dim rstExcel As DAO.Recordset
    Dim mySQL As String
    Dim FileName As String
    
    'Set up
    Set db = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set rstTable = db.OpenRecordset("SELECT Code FROM tble_practice")
    rstTable.MoveFirst
    
    'Don't need to check for .eof and .bof here, you've already got everying in a loop
    'If the table has no records, rstTable will just skip the loop
    Do Until rstTable.EOF
        'You can change the file name to whatever you want as long
        'as it will create different file names for each record
        FileName = "Quarterly Submisstion - " & rstTable("Code")
        'Set up your SQL and bring in the value of Code for this record
        mySQL = "TRANSFORM Sum(PAYMENTS_calcs.Activity) AS SumOfActivity " & _
            "SELECT PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
            "FROM PAYMENTS_calcs " & _
            "WHERE (((PAYMENTS_calcs.Code)='" & rstTable("Code") & "') AND ((PAYMENTS_calcs.Activity)>0)) " & _
            "GROUP BY PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
            "ORDER BY PAYMENTS_calcs.ID_Statement, PAYMENTS_calcs.Code " & _
            "PIVOT Left([Quartercode],2) In ('Q1','Q2','Q3','Q4');"
        'Not sure what the name of your crosstab query is but I'll assume it's Tble_Statementno
        db.QueryDefs("Tble_statementno").SQL = mySQL
        'Set the recordset you will be exporting to excel.
        'Again, not sure what this query's name is so I'll call it SomeQuery
        Set rstExcel = db.OpenRecordset("SomeQuery")
        'Call our Export function and give it our recordset and new file name
        ExportExcel rstExcel, FileName
        'Move to the next record
        rstTable.MoveNext
    Loop

    xlApp.Quit
    rstTable.Close
    rstExcel.Close
    
    Set xlApp = Nothing
    Set rstTable = Nothing
    Set rstExcel = Nothing
End Sub

Private Sub ExportExcel(rst As DAO.Recordset, NewFileName As String)
    Dim xlWorkbook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim lvlColumn As Integer
    Dim MasterPath As String
    Dim DestinationPath As String
    
    'Change master path to location of your master spreadsheet and
    'DestinationPath to where you want the Excel files to be saved
    MasterPath = "C:\Quarterly submission MASTER 2012-2013.xls"
    DestinationPath = "C:\"
    
    'Set up Excel document
    Set xlWorkbook = xlApp.Workbooks.Open(MasterPath)
    Set xlSheet = xlWorkbook.Sheets(1)

    'Insert Data
    With xlSheet
        'Insert your Code for putting things in the correct cells here.
        'This is how I bring data into the sheet:
        '.Range("D6").CopyFromRecordset rst
    End With

    'Save Excel document as [New File Name].xls
    xlWorkbook.SaveAs DestinationPath & "\" & NewFileName & ".xls"
    xlWorkbook.Close
    
    rst.Close
    
    Set rst = Nothing
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
End Sub

 

[GregRun]

Did this work for you?

 

[Pat Hartman]

The pivoted columns of a CrossTab can be controlled in two ways.
Use a Left Join to a table that contains all the values in the select part of the query.

An alternative is to provide a list of column headings as in the following example
TRANSFORM Count(SAVEtblAuditParms.[AuditName]) AS CountOfAuditName
SELECT SAVEtblAuditParms.[AuditParmsID], Count(SAVEtblAuditParms.[AuditName]) AS [Total Of AuditName]
FROM SAVEtblAuditParms
GROUP BY SAVEtblAuditParms.[AuditParmsID]
PIVOT SAVEtblAuditParms.[CoState] In ("CT","RI","NY");
The downside with this method is if your source data contains values not specified in the list, those records will be ignored. So in my example, if one of the records was for MA, it would not be included in the output. Therefore, when I need to control the set of columns for a crosstab, I use the lookup table that defines them so that query would look like:
TRANSFORM Count(SAVEtblAuditParms.[AuditName]) AS CountOfAuditName
SELECT SAVEtblAuditParms.[AuditParmsID], Count(SAVEtblAuditParms.[AuditName]) AS [Total Of AuditName]
FROM SAVEtblAuditParms RIGHT JOIN tblStates ON SAVEtblAuditParms.CoState = tblStates.StateAbbr
GROUP BY SAVEtblAuditParms.[AuditParmsID]
PIVOT SAVEtblAuditParms.[CoState];

 

[scubadiver007]

It says the following:

Dim xlWorkbook As Excel.Workbook

is undefined.

If I understand correctly, the following:

db.QueryDefs("qry_statementno").SQL = mySQL

save the SQL string and creates a query called "qry_statementno" ??

I'm not sure how that line relates to:

Set rstExcel = db.OpenRecordset("statement_export")

I have changed the SQL so I now have two queries joined to a table with both using left joins.

 

[GregRun]

It says the following:

Code:
Dim xlWorkbook As Excel.Workbook
is undefined.

Sorry, I forgot to mention you need to add a reference to the Excel Object Library. In the VBA Editor go to Tools>References... and check the checkbox for "Microsoft Excel 12.0 Object Library". The version number might be different based on your version of Office.

If I understand correctly, the following:

Code:
db.QueryDefs("qry_statementno").SQL = mySQL
save the SQL string and creates a query called "qry_statementno" ??

You need to change "qry_statementno" to the name of your crosstab query as it says in the notes. I didn't have the name of your query. I should have made this query named "SomeQuery" to decrease confusion. That should answer your next question but...

I'm not sure how that line relates to:

Code:
Set rstExcel = db.OpenRecordset("statement_export")
I have changed the SQL so I now have two queries joined to a table with both using left joins.

You changed "SomeQuery" to "statement_export" here. Again, this was supposed to represent the name of your crosstab query. It should be the same name as question #2.

 

[scubadiver007]

I have adapted my original VBA code to create a test query using a crosstab query with two filters:

Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim strsql As String
Dim query1 As QueryDef
Set db = CurrentDb()
Set rst = db.OpenRecordset("Select kcode from tble_practice;")
With rst
If Not (.EOF And .BOF) Then
.MoveFirst
Do Until rst.EOF
 
 
strsql = "TRANSFORM Sum(PAYMENTS_calcs.Activity) AS SumOfActivity " & _
"SELECT PAYMENTS_calcs.ID_activity, PAYMENTS_calcs.Kcode " & _
"FROM PAYMENTS_calcs " & _
"WHERE (((PAYMENTS_calcs.Kcode)=' " & rst("kcode") & " ') AND ((PAYMENTS_calcs.ID_activity) Is Not Null) AND ((PAYMENTS_calcs.Activity)>0)) " & _
"GROUP BY PAYMENTS_calcs.ID_activity, PAYMENTS_calcs.Kcode " & _
"PIVOT Left([Quartercode],2) In ('Q1','Q2','Q3','Q4'); "
 
Set query1 = db.CreateQueryDef("querytest", strsql)
.MoveNext
Loop
End If
.Close
End With
Set rst = Nothing
Set db = Nothing

It works but it takes about six minutes for the query to appear in the objects list. If it takes that long to do one query, I would be better off exporting the whole dataset to Excel and creating the sheets using VBA rather than in Access.

 

[GregRun]

Where did you find this code? It re-creates and overwrites the same query over and over and over again from scratch and does nothing with it... this is not what we discussed. If this is the approach you want to take, you need to redefine the SQL each time through the loop, not create a query def and overwrite the old one each time.

That aside...

As I had said in a previous post, I really am not sure that you need a crosstab query here. From looking at your code, I am fairly certain you can get this data much faster by using a SELECT query. Crosstab queries are much slower (in my experience) than standard queries. I tried to use Crosstab queries when I first started using Access (because I had used Pivot tables in Excel) but I quickly noticed that with large datasets it was taking a ridiculous amount of time to produce a crosstab query. One of the advantages to using a Crosstab query is that the user gets to select their own filters and it recalculates on the fly. However, since you're just dumping this data into excel without the user seeing it, this advantage is moot.

Try setting up your query like this:

SELECT ID_activity, KCode, Sum(IIf(Left(QuarterCode,2) = 'Q1', Activity, 0)) As Q1Activity, Sum(IIf(Left(QuarterCode,2) = 'Q2', Activity, 0)) As Q2Activity, Sum(IIf(Left(QuarterCode,2) = 'Q3', Activity, 0)) As Q3Activity, Sum(IIf(Left(QuarterCode,2) = 'Q4', Activity, 0)) As Q4Activity FROM PAYMENTS_calcs GROUP BY ID_activity, Kcode HAVING Nz(ID_Activity,0)>0

 

[scubadiver007]

Unfortunately the activity and payment calculations are quite complicated and the spreadsheets will be sent out to users for them to check.

I'm not at work at the moment but I will have a look at the code tomorrow.

 

[GregRun]

Sure, but you're not doing any of that calculation inside of the crosstab query. Your crosstab query is simply summarizing the data you have already calculated.

 

[scubadiver007]

I have looked at replacing the crosstab SQL and I wasn't aware that such a way exists.

The microsoft office 12.0 object library is ticked but the excel workbook still throws up an error.

 

[GregRun]

...check the checkbox for "Microsoft Excel 12.0 Object Library"...

Please read these carefully. You're looking for the Microsoft EXCEL 12.0 Object Library.

 

[scubadiver007]

I found the library but I wasn't as clear as I should have been. I have a query for activity (call it "qry_activity") from one table and I have a query for payments (call it "qry_payments") from a second table. I need to join each of those two to "tble_statementno" using a left join to both so the rows are correctly aligned and all rows are included. I need to export this third query to Excel (call it "qry_export").

Can your Excel export function be able to exclude the query headings? I have been using an export function that can do this which is why I am reluctant to do something different. Also in your function you have "newfilename" which doesn't exist so is it a typo?

Just so I don't keep doing it for every Kcode, I am filtering the openrecordset line for one record. At the moment, I am not really interested in export the data because I want to concentrate on making sure the data is correct.

If I am unable to do this, I do have a plan B

    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim rstExcel As DAO.Recordset
    Dim mySQL As String
    Dim FileName As String
    Set db = CurrentDb
    Set xlApp = CreateObject("Excel.Application")
    Set rst = db.OpenRecordset("SELECT Kcode FROM tble_practice where KCode = 'K81002';")
    rst.MoveFirst
 
    Do Until rst.EOF
 
        mySQL = "SELECT Tble_Activity.KCode, Tble_Indicator.ID_activity, " & _
                 "Sum(IIf(Left([QuarterCode],2)='Q1',[Activity],0)) AS Q1, " & _
                 "Sum(IIf(Left([QuarterCode],2)='Q2',[Activity],0)) AS Q2, " & _
                 "Sum(IIf(Left([QuarterCode],2)='Q3',[Activity],0)) AS Q3, " & _
                 "Sum(IIf(Left([QuarterCode],2)='Q4',[Activity],0)) AS Q4 " & _
                 "FROM Tble_Indicator INNER JOIN Tble_Activity ON (Tble_Indicator.ID_payment = Tble_Activity.PaymentID) AND (Tble_Indicator.Indicator = Tble_Activity.Fieldname) " & _
                 "GROUP BY Tble_Activity.KCode, Tble_Indicator.ID_activity " & _
                 "HAVING (((Tble_Activity.KCode)= ' " & rst("kcode") & " ')); "
 
        db.QueryDefs("myquery").SQL = mySQL
 
        rst.MoveNext

 

[GregRun]

The only way I'm going to be able to actually write the query for you is for you to post your database.

 

[scubadiver007]

I have given you the brake pads instead of the whole car
I have included data for two Kcodes and I need to export "query_export".

I have also included the two functions I have used to export data to excel in the past.