Exporting Crosstab Query

J

jd.willis

Registered User.
Local time
Yesterday, 19:14
Joined
Jun 7, 2010
Messages
28
I have a crosstab query this is set up as such:

PHP: 
TRANSFORM Sum([30q_Rehab_RVU_Summary_Step_01].RVU) AS SumOfRVU
SELECT [30q_Rehab_RVU_Summary_Step_01].COID, [30q_Rehab_RVU_Summary_Step_01].Post_Date, [30q_Rehab_RVU_Summary_Step_01].Pt_Num, [30q_Rehab_RVU_Summary_Step_01].Pt_Name, Sum([30q_Rehab_RVU_Summary_Step_01].RVU) AS [Total Of RVU]
FROM 30q_Rehab_RVU_Summary_Step_01
GROUP BY [30q_Rehab_RVU_Summary_Step_01].COID, [30q_Rehab_RVU_Summary_Step_01].Post_Date, [30q_Rehab_RVU_Summary_Step_01].Pt_Num, [30q_Rehab_RVU_Summary_Step_01].Pt_Name
PIVOT Format([Trans_Date],"Short Date");


The results are like this

COID Post_Date PT_NUM PT_NAME Trans_Date(s)===>
HH 6/7/10 1234567987 Doe, John RVU$
SE 6/7/10 45698713 Doe, Jane RVu$
TR 6/7/10 00000001 Smith, John
NE 6/7/10 45698732145 Smith, Jane


The Trans_date columns fluxuate based on the date that charges were entered vs date of transaction.

How can I ensure that I capture all fields when i'm trying to export to excel?
 
Also in the template file I would like to overwrite the column headings as those change according to the trans date.
 
I'm attaching the query results that I pasted into a spreadsheet.

Also attaching a sample db with the existing query and the excel template file.
Thank you in advance for help with this!

(I appologize I uploaed the wrong template file) Updated the correct template file to TMC_eDRO3000 (2010-02-22).zip.


Below is the code that I'm trying to work on.

Thanks again!
Code: 
Private Sub TMCeDRO3000_Click()
On Error Resume Next
    Dim sCriteria As String
    Dim db As Database
    Dim rst As Recordset
    Dim objApp As Excel.Application
    Dim objBook As Excel.Workbook
    Dim objSheet As Excel.Worksheet
    Dim strTemplatePath As String
    Dim sOutput As String
 
    sCriteria = " 1 = 1 "
    If COID <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].COID = """ & COID & """"
    End If
    If Post_Date <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].Post_Date = """ & Post_Date & """"
    End If
    If PT_NUM <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].PT_NUM  """ & PT_NUM & """"
    End If
 
    If "PT_NAME" <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].[PT_NAME]  """ & "PT_NAME" & """"
    End If
 
    If "Total of RVU" <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].[Total of RVU] = """ & "Total of RVU" & """"
    End If
 
 
 'Unsure of how to address the different dates/column fields going forward
 
 
 
    Set db = CurrentDb()
    'This is new
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_eDRO3000 (2010-02-22).xlt" ' template file reference
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TMC_eDRO3000" & " (" & Format(Date, "yyyy-mm-dd") & ").xls" 'output file name and path
 
 
 
    'This is new
    Set objApp = New Excel.Application
    'This is new 'Your excel spreadsheet file goes here
    Set objBook = objApp.Workbooks.Add(strTemplatePath)
    'Name of sheet you want to export to
    Set objApp = objBook.Parent
    Set objSheet = objBook.Worksheets("Heart Center RVU by Service")
    objBook.Windows(1).Visible = True
    'Opens the recordset and sets the variable
 
    Set rst = db.OpenRecordset("10q_Daily_eDRO3000_Rehab_RVU_Summary")
    With objSheet
        .Select
        'Clears the current contents in the workbook range
        '.Range("A5:I65000").ClearContents
        'rst Copies the recordset into the worksheet
        .Range("A2").CopyFromRecordset rst
    End With
    objBook.SaveAs (sOutput)
    objBook.Close
    rst.Close
    objApp.Visible = False
    Set rst = Nothing
    Set db = Nothing
    Set objSheet = Nothing
    Set objBook = Nothing
    Set objApp = Nothing
    MsgBox "TMC eDRO3000 has been published"
End Sub
 

Attachments

Last edited:
This code exports the data, however I need also copy over the column headings from the query into this template inorder to have the published correctly. The row that has to be overwritten is preformatted with a border color and auto filter.


Any ideas/suggestions I can try to have this do that?:confused::confused::confused:

Code: 
Private Sub TMCeDRO3000_Click()
On Error Resume Next
    Dim sCriteria As String
    Dim db As Database
    Dim rst As Recordset
    Dim objApp As Excel.Application
    Dim objBook As Excel.Workbook
    Dim objSheet As Excel.Worksheet
    Dim strTemplatePath As String
    Dim sOutput As String
    
    sCriteria = " 1 = 1 "
    If COID <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].COID = """ & COID & """"
    End If
    If Post_Date <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].Post_Date = """ & Post_Date & """"
    End If
    If PT_NUM <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].PT_NUM  """ & PT_NUM & """"
    End If
    
    If "PT_NAME" <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].[PT_NAME]  """ & "PT_NAME" & """"
    End If
    
    If "Total of RVU" <> "" Then
        sCriteria = sCriteria & " AND [10q_Daily_eDRO3000_Rehab_RVU_Summary].[Total of RVU] = """ & "Total of RVU" & """"
    End If
    'Unsure of how to address the different dates/column fields going forward
    
    
    
    Set db = CurrentDb()
    'This is new
    strTemplatePath = "W:\HER\HER - Administration\revops\RevOps_Databases\Monarch\ROSS_Uploads\01 - Daily\Excel Templates\TMC_eDRO3000 (2010-02-22).xlt" ' template file reference
    sOutput = "W:\HER\HER - Patient Access Management\PasCoord\Process Improvement Team\Jason\Revops\TMC_eDRO3000" & " (" & Format(Date, "yyyy-mm-dd") & ").xls" 'output file name and path
    

    
    'This is new
    Set objApp = New Excel.Application
    'This is new 'Your excel spreadsheet file goes here
    Set objBook = objApp.Workbooks.Add(strTemplatePath)
    'Name of sheet you want to export to
    Set objApp = objBook.Parent
    Set objSheet = objBook.Worksheets("eDRO3000")
    objBook.Windows(1).Visible = True
    'Opens the recordset and sets the variable
    
    Set rst = db.OpenRecordset("10q_Daily_eDRO3000_Rehab_RVU_Summary")
    With objSheet
        .Select
        'Clears the current contents in the workbook range
        '.Range("A5:I65000").ClearContents
        'rst Copies the recordset into the worksheet
        .Range("A5").CopyFromRecordset rst
    End With
    objBook.SaveAs (sOutput)
    objBook.Close
    rst.Close
    objApp.Visible = False
    Set rst = Nothing
    Set db = Nothing
    Set objSheet = Nothing
    Set objBook = Nothing
    Set objApp = Nothing
    MsgBox "TMC eDRO3000 has been published"
End Sub
 
You must log in or register to reply here.

Similar threads

R
Crosstab or transpose query with multiple fields
2
Replies
21
Views
1,376
CJ_London
C
C
Crosstab query that uses Form field as criteria
Replies
14
Views
1,122
Ken Sheridan
Ken Sheridan
Z
how to sum highest 5 values in access crosstab query
Replies
8
Views
725
cheekybuddha
cheekybuddha
adhoustonj
Sum pivot query troubles
Replies
14
Views
1,390
plog
P
M
Crosstab report with calculated label to show each day of month as label and working hours depending on employee shifts
Replies
2
Views
1,386
Gasman
Gasman

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom