Question : Export to Excel Grouping

I have this code to export to Excel and it works fine. The 1st 6 lines in the sheet are values from 1 query and everthing below that on the sheet is data from another query that is filtered by 1 department. I need to expand on this and create a workbook that has a new sheet for each department with the tab name as the Department.

In my current code:
Set qdf = db.QueryDefs("qry_ExportRoster_Department_Staff_Sums3")
            For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
            Next prm

The parameter here is based on a forms combo box with all the departments listed. I created a new query "qry_Sums_All", that list all departments and their sums. This is the query I want to use to create the workbook,

Any help is appreciated.
Code Snippet: 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:

Dim xlObj As Object
    Dim rs As DAO.Recordset
    Dim j As Integer
    Dim rowCnt As Integer
    Dim curRow As Integer
    Dim filePathName As String
    Dim tabName As String
    Dim db As Database
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Set db = CurrentDb
    
    filePathName = Me!txtFolder & Me!txt_Title & Me!txt_Title_Ext

    Set xlObj = CreateObject("Excel.application")

        xlObj.Workbooks.Add
        
        With xlObj
            .Worksheets(1).Select
            
            .Range("A1") = "Roster Date:"
            .Range("A2") = "Department:"
            .Range("A3") = "Department ID:"
            .Range("A4") = "SpeedType:"
            .Range("A5") = "Budgeted FTE:"
            .Range("A6") = "Budgeted Salaries:"
            .Range("A7") = "Funds Available:"
            
            .Range("B1") = DLookup("[rosterDate]", "qry_ExportRoster_Department_Staff_Sums3A")
            .Range("B2") = DLookup("[department]", "qry_ExportRoster_Department_Staff_Sums3A")
            .Range("B3") = DLookup("[departmentID]", "qry_ExportRoster_Department_Staff_Sums3A")
            .Range("B4") = DLookup("[speedtype]", "qry_ExportRoster_Department_Staff_Sums3A")
            .Range("B5") = DLookup("[budgetedFTE]", "qry_ExportRoster_Department_Staff_Sums3A")
            .Range("B6") = DLookup("[budget]", "qry_ExportRoster_Department_Staff_Sums3A")

            rowCnt = .Worksheets(1).UsedRange.Rows.Count
            
            Set qdf = db.QueryDefs("qry_ExportRoster_Department_Staff_Sums3")
            For Each prm In qdf.Parameters
            prm.Value = Eval(prm.Name)
            Next prm
            
            Set rs = qdf.OpenRecordset(dbOpenDynaset)
            
            For j = 0 To rs.Fields.Count - 1
                .Cells(rowCnt + 2, j + 1).Value = rs(j).Name
            Next
            .Range("A" & rowCnt + 3).CopyFromRecordset rs
            rowCnt = .Worksheets(1).UsedRange.Rows.Count
            
            'Sum Columns
            .Range("E" & rowCnt + 1 & "").Formula = "=Sum(" & "E10:E" & rowCnt & " )"
            .Range("F" & rowCnt + 1 & "").Formula = "=Sum(" & "F10:F" & rowCnt & " )"
            .Range("G" & rowCnt + 1 & "").Formula = "=Sum(" & "G10:G" & rowCnt & " )"
            .Range("H" & rowCnt + 1 & "").Formula = "=Sum(" & "H10:H" & rowCnt & " )"
            
            .Range("B7").Formula = "=B6-Sum(" & "G10:G" & rowCnt & " )"
            
            'Formatting
            .Rows("1:" & rowCnt + 1).RowHeight = 20
            .Rows("9:9").RowHeight = 50
            .Cells.Font.Name = "Arial"
            .Cells.Font.Size = 12
            .Range("A9:N9").Interior.ColorIndex = 15
            .Rows("1:1").WrapText = True
            .Rows("9:9").WrapText = True
                    
            .Columns("A").HorizontalAlignment = xlCenter
            .Columns("B:C").HorizontalAlignment = xlLeft
            .Columns("D:F").HorizontalAlignment = xlCenter
            .Columns("G:J").HorizontalAlignment = xlRight
            .Columns("K:M").HorizontalAlignment = xlCenter
            .Columns("N").HorizontalAlignment = xlLeft
            
            .Range("A1:A7").HorizontalAlignment = xlLeft
            .Rows("9:9").HorizontalAlignment = xlCenter
            .Rows("1:" & rowCnt + 1).VerticalAlignment = xlCenter
            
            'Set Borders for 9th Row
            With .Range("A9:N9").Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N9").Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N9").Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N9").Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N9").Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N" & rowCnt + 1).Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N" & rowCnt).Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N" & rowCnt).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N" & rowCnt).Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With
            With .Range("A9:N" & rowCnt).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThick
                .ColorIndex = xlAutomatic
            End With

            'Set Column Formats
            .Columns("A").NumberFormat = "###0"
            .Columns("D").NumberFormat = "###0"
            .Columns("E:F").NumberFormat = "0.00"
            .Columns("G:J").NumberFormat = "$#,##0.00"
            .Columns("L").NumberFormat = "0.00"
            .Columns("M").NumberFormat = "mm/dd/yyyy"
            .Range("B5").NumberFormat = "0.00"
            
            'Set Column Widths
            .Columns("A").ColumnWidth = 20
            .Columns("B").ColumnWidth = 33
            .Columns("C").ColumnWidth = 35
            .Columns("D").ColumnWidth = 12
            .Columns("E:F").ColumnWidth = 10
            .Columns("G:H").ColumnWidth = 17
            .Columns("I").ColumnWidth = 14
            .Columns("J:L").ColumnWidth = 10
            .Columns("M").ColumnWidth = 16
            .Columns("N").ColumnWidth = 24
            
            With xlObj
                .Sheets("Sheet1").Select
                .Sheets("Sheet1").Name = .Range("B2").Value
                .Sheets("Sheet2").Select
                .ActiveWindow.SelectedSheets.Delete
                .Sheets("Sheet3").Select
                .ActiveWindow.SelectedSheets.Delete
                .ActiveWindow.Zoom = 80
            End With
            
            'Required to turn off PageSetup.Zoom so FitToPagesWide and FitToPagesTall work
            xlObj.ActiveSheet.PageSetup.Zoom = False
            
            With xlObj.ActiveSheet.PageSetup
                .LeftMargin = xlObj.Application.InchesToPoints(0.5)
                .RightMargin = xlObj.Application.InchesToPoints(0.5)
                .TopMargin = xlObj.Application.InchesToPoints(0.5)
                .BottomMargin = xlObj.Application.InchesToPoints(0.5)
                .HeaderMargin = xlObj.Application.InchesToPoints(0.5)
                .FooterMargin = xlObj.Application.InchesToPoints(0.5)
                .Orientation = xlLandscape
                .FitToPagesWide = 1
                .FitToPagesTall = 1
                .PrintArea = "$A:$N"
            End With
            
            .ActiveWorkbook.SaveAs filePathName
        End With

        'Set xlObj = Nothing
        xlObj.Quit
        rs.Close
Open in New Window
Select All

Answer : Export to Excel Grouping

GH,

I've attached your new file.  It should do exactly what you want it to do.  FYI:  I put your code in an external code module (seperate from the form).  You find it in the Modules section.  I like to do that so I can run the code without having to move the form back and forth between Form and Design views.

I also added formatting where it seemed appropriate.  Hope that solves this issue.
 
Roster-TESTNew.mdb (3.2 MB) (File Type Details) 
File contains new code
 
Random Solutions  
 
programming4us programming4us