I didn't try Paul's solution (yet)
I kinda got invested in this using VBA. It has been a while since I used Access automation to manipulate Excel.
I spent way more hours on this than I should have, but I am not going to be defeated. (I hope)
Note: There needs to be a reference set to "Microsoft Excel 14.0 Object Library".
You will need/should add error handler code.
Here is the code:
Code:
Option Compare Database
Option Explicit
Sub ExportSA()
Dim d As DAO.Database
Dim r As DAO.Recordset
Dim sSQL As String
Dim xlx As Object
Dim xlw As Object
Dim xls As Object
Dim xlc As Object
Dim strPathFileName As String
Dim strRecordsetDataSource As String
Dim lngColumn As Long
Dim blnEXCEL As Boolean
Dim blnHeaderRow As Boolean
Dim sa_Array() '<<-- array if unique sanames
Dim rc As Integer '<<-- record count
Dim i As Integer '<<-- just a counter
Set d = CurrentDb()
blnEXCEL = False
' Replace True with False if you do not want the first row of the worksheet to be a header row (the names of the fields from the recordset)
blnHeaderRow = True
'+=+=+=+=+= query to get the unique saNames +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=
sSQL = " SELECT DISTINCT sifcpct.saname"
sSQL = sSQL & " FROM salesinfoforcurryrplan_crosstab sifcpct"
sSQL = sSQL & " ORDER BY sifcpct.saname;"
'get the unique sanames
Set r = d.OpenRecordset(sSQL)
If r.BOF And r.EOF Then
MsgBox " No Records to export! Aborting"
Exit Sub
Else
r.MoveLast '<<-- fill the recordset
rc = r.RecordCount ' <<-- number of unique sanames
r.MoveFirst
' now we know the number of exements needed in the array
ReDim sa_Array(rc)
'fill array
For i = 1 To rc
sa_Array(i) = r.Fields("saname")
r.MoveNext
Next
End If
r.Close 'close recordset
'++=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+
' Replace C:\Filename.xls with the actual path and filename that will be used to save the new EXCEL file into which you will write the data
strPathFileName = CurrentProject.Path & "\ExcelFilesToRepsForInputDataZZ_Plan_Sales.xlsx"
' Replace QueryOrTableName with the real name of the table or query whose data are to be written into the worksheet
strRecordsetDataSource = "salesinfoforcurryrplan_crosstab"
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be visible when the code is running
xlx.Visible = False
' Create a new EXCEL workbook => Set xlw = xlx.Workbooks.Add(strPathFileName)
Set xlw = xlx.Workbooks.Add(xlWBATWorksheet)
'Loop to create worksheet for each Rep
For i = 1 To rc '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
xlw.Worksheets.Add After:=xlw.Worksheets(xlw.Worksheets.Count)
' MsgBox xlw.Worksheets.Count
'delete "Sheet1"
If i = 1 Then
xlw.Worksheets("Sheet1").Delete
End If
xlw.ActiveSheet.Name = sa_Array(i)
Set xls = xlw.ActiveSheet
' Replace A1 with the cell reference of the first cell into which the headers will be written (blnHeaderRow = True),
' or into which the data values will be written (blnHeaderRow = False)
Set xlc = xls.Range("A1") ' this is the first cell into which data go
'Crosstab SQL by Sales Rep
sSQL = "TRANSFORM Sum(SalesInfoforCurrYrPlan.SumOfIHDAR_FCAMT1) AS SumOfSumOfIHDAR_FCAMT1"
sSQL = sSQL & " SELECT SalesInfoforCurrYrPlan.saname, SalesInfoforCurrYrPlan.plant, SalesInfoforCurrYrPlan.CSNAME, "
sSQL = sSQL & " SalesInfoforCurrYrPlan.PLYear, Sum(SalesInfoforCurrYrPlan.SumOfIHDAR_FCAMT1) AS [Total Of SumOfIHDAR_FCAMT1]"
sSQL = sSQL & " FROM SalesInfoforCurrYrPlan"
sSQL = sSQL & " WHERE SalesInfoforCurrYrPlan.saname ='" & sa_Array(i) & "'"
sSQL = sSQL & " GROUP BY SalesInfoforCurrYrPlan.saname, SalesInfoforCurrYrPlan.plant, SalesInfoforCurrYrPlan.CSNAME, SalesInfoforCurrYrPlan.PLYear"
sSQL = sSQL & " ORDER BY SalesInfoforCurrYrPlan.saname, SalesInfoforCurrYrPlan.plant, SalesInfoforCurrYrPlan.CSNAME, SalesInfoforCurrYrPlan.PLYear"
sSQL = sSQL & " PIVOT SalesInfoforCurrYrPlan.PLMth;"
Set r = d.OpenRecordset(sSQL, dbOpenDynaset, dbReadOnly)
If r.EOF = False And r.BOF = False Then
r.MoveLast
r.MoveFirst
' Write the HEADER row to worksheet
If blnHeaderRow = True Then
For lngColumn = 0 To r.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = r.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' write DATA to worksheet
Do While r.EOF = False
For lngColumn = 0 To r.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = r.Fields(lngColumn).Value
Next lngColumn
r.MoveNext
Set xlc = xlc.Offset(1, 0)
Loop
End If
Next '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Clean up the VB objects
r.Close
Set r = Nothing
d.Close
Set d = Nothing
' Save and close the EXCEL file, and clean up the EXCEL objects
xlw.SaveAs strPathFileName
xlw.Close False
Set xlw = Nothing
If blnEXCEL = True Then
xlx.Quit
End If
Set xlx = Nothing
Set xlc = Nothing
Set xls = Nothing
MsgBox "Data have been exported.", vbOKOnly
End Sub
I can attach the dB I created if you have trouble....
Good luck with your project..