Exporting to Excel on different Worksheets

[David Gerber]

This is a VBA question.

Currently, I have a query/recordset that is being exported to Excel, but on
one ("Master") worksheet. However, I would like the records to be organized /
split across several different worksheets according to a number assigned to
each individual record ("ProjectID"); these worksheets would be added for
each unique ProjectID. Right now, I'm attempting to embellish a generic "For
Each" statement, but with no luck thus far. Any ideas?

Thanks,
David

[Ken Snell [MVP]]

Use separate queries to export the data. One query for each ProjectID value.
The TransferSpreadsheet action will write to new worksheets so long as the
query names are different and the target EXCEL file name is the same.

If you provide more details about what you're doing and what your code looks
like, we can assist you with this.

--

Ken Snell
<MS ACCESS MVP>

"David Gerber" <David...@discussions.microsoft.com> wrote in message
news:C71A0BFE-204A-4484...@microsoft.com...

[David Gerber]

Here's the code that writes to the "Master" worksheet, which runs off one
query. If possible, we're looking for code to loop through this single-query
recordset and break down / separate the data into separate worksheets using
the value in the "ProjectID" field. We currently use separate queries to
place them into separate worksheets; however, a handful of ProjectIDs are
added on a daily basis. As such, rather than continually add additional
queries and update the VBA code each day, we are hoping there is a way for it
to be an automated process. Right now, we're thinking we need a For Each
("ProjectId") statement within the Do While Loop, but have no idea what the
script would look like. Any help is greatly appreciated.

Dim iDatabase As DAO.Database
Dim iRecordset As DAO.Recordset
Dim iApplication As Excel.Application
Dim iWorkbook As Excel.Workbook
Dim iWorkSheet As Excel.Worksheet
Dim iRow As Integer
Dim iRecord As Variant

Set iApplication = New Excel.Application
iApplication.Visible = True
Set iWorkbook = iApplication.Workbooks.Add()
Set iWorkSheet = iWorkbook.Worksheets("Sheet1")

iRow = 1
iWorkSheet.NAME = "Master"

DoCmd.OpenQuery ("Query_Gates_Master")
Set iRecordset = CurrentDb.OpenRecordset("Query_GATES_Master")
iRecordset.MoveFirst

Do While Not iRecordset.EOF
iWorkSheet.Cells(iRow, 1).Value = iRecordset!NAME
iWorkSheet.Cells(iRow, 2).Value = iRecordset!ProjectID
iWorkSheet.Cells(iRow, 3).Value = iRecordset!R_TaskID
iWorkSheet.Cells(iRow, 4).Value = iRecordset!OLD_TASK
iWorkSheet.Cells(iRow, 5).Value = iRecordset!CHARGE_MOC
iWorkSheet.Cells(iRow, 6).Value = iRecordset!CHARGE_RC
iWorkSheet.Cells(iRow, 7).Value = iRecordset!PPD
iWorkSheet.Cells(iRow, 8).Value = iRecordset!MGR_CODE
iWorkSheet.Cells(iRow, 9).Value = iRecordset!JOB_CODE
iWorkSheet.Cells(iRow, 10).Value = iRecordset!ACCOUNT
iWorkSheet.Cells(iRow, 11).Value = iRecordset!PAY_TYPE
iWorkSheet.Cells(iRow, 12).Value = iRecordset!HOURS
iWorkSheet.Cells(iRow, 13).Value = iRecordset!CARD_TYPE
iWorkSheet.Cells(iRow, 14).Value = iRecordset!AMOUNT
iWorkSheet.Cells(iRow, 15).Value = iRecordset!BILLABLE
iRow = iRow + 1
iRecordset.MoveNext
Loop

DoCmd.Close acQuery, "Query_GATES_Master"
iRecordset.Close
iWorkSheet.Range("A1").Select

Set iApplication = Nothing
Set iWorkbook = Nothing
Set iWorkSheet = Nothing

iApplication.Visible = True
------------------------------------------------------

[David Lloyd]

David:

Below is some code that loops through a set of ProjectIDs and exports to
separate worksheets for each ProjectID. Obviously, you will need to adjust
it to your needs. One note, if the export workbook is open when you try
this you will get an error. I have not trapped for this outcome. Again,
you will have to adjust this to your requirements. This is just one
alternative way to handle something like this.

Public Function ExportSheets() As Boolean
Dim db As Database
Dim sSQL As String
Dim rs As Recordset
Dim qdf As QueryDef

Set db = CurrentDb

Set rs = db.OpenRecordset("SELECT DISTINCT ProjectID FROM Projects;")

Do Until rs.EOF
Set qdf = db.CreateQueryDef()
sSQL = "SELECT Projects.* From Projects WHERE Projects.ProjectID=" &
rs("ProjectID") & ";"
qdf.SQL = sSQL
qdf.Name = "ProjectID" & rs("ProjectID")
db.QueryDefs.Append qdf
Application.RefreshDatabaseWindow
DoCmd.TransferSpreadsheet acExport, , qdf.Name, "H:\TestExport.xls"
db.QueryDefs.Delete qdf.Name
Application.RefreshDatabaseWindow
Set qdf = Nothing
rs.MoveNext
Loop

ExportSheets = True

Set rs = Nothing
Set db = Nothing

End Sub

--
David Lloyd
MCSD .NET
http://LemingtonConsulting.com

This response is supplied "as is" without any representations or warranties.

"David Gerber" <David...@discussions.microsoft.com> wrote in message
news:C71A0BFE-204A-4484...@microsoft.com...

[Kevin Newman]

David,

Since it appears that you will be exporting the same data for each project,
it seems to me that you can still use the "For Each" loop. You will need to
define a new query using a concatenated SQL string within each loop with your
selection criteria and utilize the "Project ID" as the name of that query.
Then you can transfer that query to the spreadsheet within the same loop.
Define a variable to contain the "Project ID" and you can use it within the
WHERE statement of your string and as the target tab for your transfer.

Best Regards,

Kevin

[David Lloyd]

Just a correction for the last line.

Public Function ExportSheets() As Boolean
Dim db As Database
Dim sSQL As String
Dim rs As Recordset
Dim qdf As QueryDef

Set db = CurrentDb

Set rs = db.OpenRecordset("SELECT DISTINCT ProjectID FROM Projects;")

Do Until rs.EOF
Set qdf = db.CreateQueryDef()
sSQL = "SELECT Projects.* From Projects WHERE Projects.ProjectID=" &
rs("ProjectID") & ";"
qdf.SQL = sSQL
qdf.Name = "ProjectID" & rs("ProjectID")
db.QueryDefs.Append qdf
Application.RefreshDatabaseWindow
DoCmd.TransferSpreadsheet acExport, , qdf.Name, "H:\TestExport.xls"
db.QueryDefs.Delete qdf.Name
Application.RefreshDatabaseWindow
Set qdf = Nothing
rs.MoveNext
Loop

ExportSheets = True

Set rs = Nothing
Set db = Nothing

End Function

--
David Lloyd
MCSD .NET
http://LemingtonConsulting.com

This response is supplied "as is" without any representations or warranties.

"David Lloyd" <Da...@NoSpamPlease.com> wrote in message
news:R8Ate.116620$CR5....@bignews1.bellsouth.net...

[Ken Snell [MVP]]

David Lloyd has posted code that should accomplish what you seek to do. Post
back if you have additional questions about it.

--

Ken Snell
<MS ACCESS MVP>

"David Gerber" <David...@discussions.microsoft.com> wrote in message

news:F9DA6B85-A0A4-454E...@microsoft.com...