How can I use VBA to SubTotal
 

I export data from Access to Excel.

I need the data to "automatically" subtotal so the user isn't required to.

Apparently Access cannot export to an Excel template file so the following is
what I currently do (followed by what I still need).

Currently:
1. The WorkBook
FileName: "CallDetail.xls"
WorkSheet: "Weekly Calls"
Named Range: "Weekly Calls" ($B$1:$C$2) the range is dynamic based on
the size of the incoming data.
Row 1 is the header row with formatting in place

2. Access exports the data using:
stDocName = "CallDetail.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryCallDetail", stDocName, , "WeeklyCalls"
Application.FollowHyperlink stDocName, , True

3. The data is inserted into CallDetail.xls beginning in the first cell of
the named range

4. The range "WeeklyCalls" is adjusted to accomodate all imported data.

What I need help with:
1. Return the file "CallDetail.xls" to its original (pre-export) condition.
2. Name the new file (with the exported data) "CallDetail mmddyy.xls" (where
mmddyy is Date())
3. Subtotal data for each break in Column A (Technician), Sum Column D
(Duration)

Thanks for your help!

--
---
TraciAnn

Message posted via http://www.officekb.com

How can I use VBA to SubTotal
 

Hi,

Here's one way you can try. It requires that you add a reference to the
Excel in your project (Tools References Microsoft Excel 8.0 Object
Library).
After the query has been exported to Excel, it opens it (instead of
being opened by Application.Hyperlink). A date variable is created for the
Save As and then it's sorted & sub-totaled & closed.
The original file is then re-opened and the query results deleted.
Hopefully this works for you, or at least helps.


Sub Ex1()

Dim stDocName As String
stDocName = "C:\VB 2008\CallDetail.xls"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
"qryCallDetails", stDocName, , "WeeklyCalls"

Dim xl As Excel.Application
Dim xlwb As Excel.Workbook

Set xl = New Excel.Application
Set xlwb = xl.Workbooks.Open(stDocName)

xl.Visible = True

Dim dtSave As String
dtSave = Format(Now(), "mmddyy")
xlwb.SaveAs ("C:\VB 2008\CallDetail" & dtSave & ".xls")

Dim WeeklyCalls As Range
Set WeeklyCalls = xlwb.Sheets("WeeklyCalls").Range("A1").CurrentRegi on

With xlwb.Sheets("WeeklyCalls").Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange WeeklyCalls
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With

With xlwb.Sheets("WeeklyCalls").Range("WeeklyCalls")
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With

xlwb.Close SaveChanges:=True

Set xlwb = xl.Workbooks.Open(stDocName)
xl.DisplayAlerts = False
xlwb.Sheets("WeeklyCalls").Delete
xl.DisplayAlerts = True
xlwb.Close SaveChanges:=True

xl.Quit

Set xl = Nothing

End Sub