Solved: Subtotals

[austenr]

Does anyone see what might be wrong with this code? I tried doing this with the macro recorder and it worked fine. I get a run time 1004 error Method of Columns Global Failed.

Columns("B:N").Select
Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(13), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

[Ken Puls]

Works fine for me, Austen. Do you have a workbook open? Is the right sheet active?

[austenr]

Hi Ken. Yes I have the workbook open. And the sheet is active. I will post the workbook later tonight.

[austenr]

Ok here is the whole code. This is being run out of access. The workbook is open and the page is the active page. I get a global error on the subtotals in the last sub. Thanks

Private Sub ICMMonthlyReports()
'On Error GoTo Err_Form_Current
'Dim dayssince As Integer
'DoCmd.Maximize
'dayssince = DateDiff("d", Me.Rundate, Date)
'MsgBox dayssince
DoCmd.SetWarnings False
' DoCmd.OpenForm "day"
' If DatePart("d", Date) = Forms![Day]![Day] Or dayssince > 31 Then
' MsgBox "run the reports"
' End If
DoCmd.DeleteObject acTable, "ICM Account Detail for Rpt"
DoCmd.DeleteObject acTable, "ICM Account Services 200608"
DoCmd.DeleteObject acTable, "ICM Account Sum for Rpt"
DoCmd.OpenQuery "mkt ICM Accounts"
DoCmd.OpenQuery "mkt ICM Acct Svcs"
DoCmd.OpenQuery "mkt ICM Service Detail for Report"
DoCmd.OpenQuery "mkt ICM Account Summary for Report"
CopyICMInputRecords
CopyAcctSumRecords
CopyICMServiceChargeDetail
End Sub
Sub CopyICMInputRecords()
'Copy detail records
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Input Records"
Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = New Excel.Application
Set rs = db.OpenRecordset("ICM Account Detail for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With
'Columns("A").Select
Columns("A").Delete
Rows(1).Select
myarray = Array("Grp Inst", "Grp Acct", "Inst Nbr", "Acct Nbr", "Acct Name", "Prim Officer", "Branch", "Svc Type Desc", "Service", "Svc Code Desc", "Nbr Item", "Charge", "Unit Charge")
Range("A1:M1").Value = myarray

Range("A1:M3000").Columns.AutoFit
Columns("L:M").Select
Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub CopyAcctSumRecords()
'Copy summary records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "ICM Account Summary"
Const conWKB_NAME = "ICM Reports August 2006.xls"
'Const conWKB_NAME = "C:\Documents and Settings\n003035\Desktop\Austens ICM\ICM Reports August 2006.xls"
Const conWKB_PATH = "C:\Documents and Settings\n003035\Desktop\Austens ICM\"
Const WKB_NAME = "ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
Set rs = db.OpenRecordset("ICM Account Sum for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_PATH & conWKB_NAME)
Err.Clear
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With


Range("A1").Select
Columns("A").Delete
myarray = Array("Grp Inst", "Grp Acct", "Grp Chg Code", "Inst Nbr", "Acct Nbr", "Acct Name", "Status", "Prim Officer", "Branch", "Date Open", "Date Closed", "Avg Ldgr Bal", "Avg Coll Bal", "Chg Code", "Svc Chg Amt", "ECR", "ECR Amt", "Total Charge")
Range("A1:R1").Value = myarray
Range("A1:R1").Columns.AutoFit

Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
End Sub
Sub CopyICMServiceChargeDetail()
'Copy subtotal records
'
Dim myarray As Variant
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Copy Service Charge Detail"
Const conWKB_NAME = "ICM Reports August 2006.xls"
Const conWKB_PATH = "C:\Documents and Settings\n003035\Desktop\Austens ICM\"
Const WKB_NAME = "ICM Reports August 2006.xls"
Set db = CurrentDb
Set objXL = Nothing
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
On Error GoTo 0
If objXL Is Nothing Then 'no open instance
Set objXL = New Excel.Application
End If
'Set objXL = New Excel.Application
Set rs = db.OpenRecordset("ICM Account Detail for Rpt", dbOpenSnapshot)
With objXL
.Visible = True
On Error Resume Next
Set objWkb = .Workbooks(conWKB_NAME)
If Err.Number <> 0 Then Set objWkb = .Workbooks.Open(conWKB_PATH & conWKB_NAME)
Err.Clear
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Range(.Cells(1, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range(.Cells(1, 1), _
.Cells(1, rs.Fields.Count)).Font.Bold = True
.Range("A2").CopyFromRecordset rs
End With
End With


'Columns("A").Delete
'Rows(1).Select
'myarray = Array("Grp Inst", "Grp Acct", "Inst Nbr", "Acct Nbr", "Acct Name", "Prim Officer", "Branch", "Svc Type Desc", "Service", "Svc Code Desc", "Nbr Item", "Charge", "Unit Charge")
'Range("B1:M1").Value = myarray
'Columns("A").Select
'Range("B1:M3000").Columns.AutoFit
Columns("M:N").Select
Selection.Subtotal GroupBy:=5, Function:=xlSum, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(13), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True


Selection.NumberFormat = "0.00"
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
Set rs = Nothing
Set db = Nothing
'Sheets("Sheet1").Delete
'Sheets("Sheet2").Delete
'Sheets("Sheet3").Delete
End Sub

[austenr]

never mind i fixed it.