Using MS Access with reference to Excel
Set OBJXL as Excel.Application
In a reporting system with Access Linked Tables to SQL Server
Then using code for custom Sorting and Grouping
The result of the Grouping (where Subtotals formula appear) are not bold in the Grouping Rows.
I use to use object code to loop and identify the cells that contained "=Subtotal", but on larger reports with dozens of tabs and hundreds of rows and 50 columns, this process was slow.
This code has seemed to speed things up.
Thought I would put it out there for critics or praises.
(or, just so I can find it for myself later)
Code:
' Bold all Subtotals in collapse level mode 1
ObjXL.ActiveSheet.Outline.ShowLevels RowLevels:=1
ObjXL.Cells.Select
ObjXL.Selection.SpecialCells(xlCellTypeVisible).Select
ObjXL.Selection.Font.Bold = True
From within Excel, remove the Objxl. reference used in remote automation.
I could never get automation to insert a subtotal / total range - so your already one up on me...
In fact I'm pretty sure I failed to make it change a exported dataset workbook into a excel formatted table. (In Excel's defence I didn't try toooo hard)
The macro recorder won't replay a Group and Subtotal. It requires a custom macro update with a custom Array. I will try to post that here when I get a break today.
I would be interested to see how that was achieved.
I have a number of reports I would like to automate that are simply too complicated either for a basic SQL server HTML query email, or a straight forward excel export.
This is the Sorting and Grouping part of that develops an Excel workbook Budget Forecasting Analysis tool. The end workbook has zero VBA.
Basically the ObjXL is a reference to Excel Public ObjXL As Excel.Application
The iStartRow is a reference to where the
Public DB As DAO.Database
Public rs2 As DAO.Recordset
Set DB2 = CurrentDb
SQLStrForEachOrg = "SELECT " & SQLVW_MonthlyRollup & ".Org FROM " & SQLVW_MonthlyRollup & " GROUP BY " & SQLVW_MonthlyRollup & ".Org;"
Set rs2 = DB2.OpenRecordset(SQLStrForEachOrg, dbOpenDynaset, dbSeeChanges) ' Single column with each Org in Linked Table
This tool has a half dozen recordsets that use Linked Tables back to SQL Server. The heavy lifting is on SQL Server.
ObjXL.Workbooks(1).Worksheets(TabName).Select ' <------------ Need to pass in Workbook Tab and LAST Column for SubTotals
ObjXL.Range(StartLocation).Select
ObjXL.ActiveWorkbook.Worksheets(TabName).Range(StartLocation).CopyFromRecordset rs, lRowcount, lfieldcount
lColumnCount = ObjXL.ActiveSheet.UsedRange.Column - 1 + ObjXL.ActiveSheet.UsedRange.Columns.Count ' count the unneeded last column after data is in
The idea is to obtain the Excel start data location, recordset counts, and other information. Then use those values to write formulas that create formulas into Excel.
There is an Excel "template" with all of the Headers and title in a folder.
This Workbook called a Template (it is just a workbook with the header and title" is opened and SavedAs. Then the iStart is used to basically past the data or formulas in.
Three of the workbooks tabs just get the data for that time period pasted in.
Now, the formulas can reference this disconnected data in the Excel tabs.
The formulas for the analysis tool include references to pull-down list box.
e.g Month - quarter - >Mo and a <Mo
Once the formulas are in place on the top row, they are copied down the number of rows that fit each data category.
I am currently running a report that creates a custom folder with a name and date. Then, it loops for each of 27 Organizations, and for each of around 30 budget categories. Each tool is around 0.5 M.
These are named to a standard, sorted and sent nationally to each individual accounting manager.
By using Excel, they can each interactively evaluate the Forecast, Actuals and Variances for the PO's. Then they have a day or two to send back the adjustments.
To get row counts, it is important to use:
rs2.MoveLast
rs2.MoveFirst
OrgRecordCount = rs2.RecordCount
If OrgRecordCount > 0 Then .....
This is a code segment for the Sorting and Grouping that requires a custom Array.
Code:
ObjXL.Range("F" & iStartRow & ":AF" & iStartRow).Select
If Rowcount > 1 Then
ObjXL.Selection.AutoFill Destination:=ObjXL.Range("F" & iStartRow & ":AF" & (iStartRow + Rowcount - 1)), Type:=xlFillDefault
End If
'ObjXL.Range("E7:V" & (Rowcount + iStartRow)).Select
ObjXL.Calculate
ObjXL.Range("B1").Select ' place highlighted cell for when user opens worksheet
ObjXL.Calculate
' Remove Column A - the ORG name then freeze rows
ObjXL.Rows(iStartRow & ":" & iStartRow).Select
ObjXL.ActiveWindow.FreezePanes = True
ObjXL.Rows((iStartRow - 1) & ":" & (iStartRow - 1)).Select
ObjXL.Selection.AutoFilter
' Sort and Grouping
Dim SubTotalColumns As Variant
SubTotalColumns = Split("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", ",")
ObjXL.Range("A" & (iStartRow - 1) & ":AF" & iEndRow).Select
ObjXL.Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(SubTotalColumns), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
DoEvents
ObjXL.Range("A" & iStartRow & ":M" & (iEndRow + 100)).Select
DoEvents
ObjXL.Selection.Rows.Ungroup
ObjXL.ActiveSheet.Outline.ShowLevels RowLevels:=1
ObjXL.Columns("D:D").Select ' Hide SLT+2
ObjXL.Selection.EntireColumn.Hidden = True
' Bold all Subtotals in colaspe level mode 1
ObjXL.ActiveSheet.Outline.ShowLevels RowLevels:=1
ObjXL.Cells.Select
ObjXL.Selection.SpecialCells(xlCellTypeVisible).Select
ObjXL.Selection.Font.Bold = True
ObjXL.Range("B2").Select ' place highlighted cell for when user opens worksheet
Exit Sub
err_trap:
Debug.Print " ActualtoBudgetrollup " & Error
Okay - that's pretty complicated at first glance - I'm looking forward to having a play with it.
Your description of the various worksheets and their functionality makes sense. Essentially let Excel do so the complicated stuff locally rather than bend access over backwards to do it.
