Subtotal Access to Excel VBA Fail (1 Viewer)

[Vagus14]

Range Class Fail, Subtotal Access to Excel VBA

Hey everyone,

I'm trying to subtotal data in an excel file but I am getting a subtotal method of Range class failed in the red text below. I have been trying to get this to work with no success. Any Ideas? Thank you!!:banghead:

Public Function SUMMARY()
Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
    Dim wb As Object
    Dim ws As Object
    Dim Lastrow As Long
    Set wb = .Workbooks.Open("D:\Summary.xlsx")
    Set ws = wb.Sheets(1)
 
    ws.Columns("B").Delete xlShiftToLeft
[COLOR=red]ws.Range("A1:R91").Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4, 5, 6, 7, _[/COLOR]
[COLOR=red]   8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Replace:=True, PageBreaks:=False, _[/COLOR]
[COLOR=red]   SummaryBelowData:=True[/COLOR]
    ws.ActiveSheet.Outline.ShowLevels RowLevels:=2
    ws.Cells.EntireColumn.AutoFit
 
xlApp.Visible = True
.ScreenUpdating = False
LinkToFile = False
SaveWithDocument = True
wb.Close
End With
End Function

 

[Rx_]

You will have to add the obligatory Access object code in the right place.
Would this be useful?

[FONT=Courier][COLOR=#00007f]Sub[/COLOR] GroupbySubtotalFormula()
    [COLOR=#00007f]Dim[/COLOR] rFormulas [COLOR=#00007f]As[/COLOR] Range, c [COLOR=#00007f]As[/COLOR] Range
    [COLOR=#00007f]Dim[/COLOR] s [COLOR=#00007f]As[/COLOR] [COLOR=#00007f]String[/COLOR]
    
    [COLOR=#00007f]Set[/COLOR] rFormulas = Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeFormulas)
    For [COLOR=#00007f]Each[/COLOR] c [COLOR=#00007f]In[/COLOR] rFormulas
        s = c.Formula
        [COLOR=#00007f]If[/COLOR] Left(s, 9) = "=SUBTOTAL" [COLOR=#00007f]Then[/COLOR]
            s = Split(Left(s, Len(s) - 1), ",")(1)
            Range(s).EntireRow.Group
        [COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
    [COLOR=#00007f]Next[/COLOR] c
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]Sub[/COLOR][/FONT]

 

[Vagus14]

Yes. Thank you Rx.

 

[Vagus14]

Working Code

Dim xlApp As Object
Dim wb As Object
Dim ws As Object
Dim Lastrow As Long
Dim i As Long
Const xlSum = -4157
 
'Establishes xl App functions.
Set xlApp = CreateObject("Excel.Application")
With xlApp
Set wb = .Workbooks.Open("D:\CLIN Summary.xlsx")
Set ws = wb.Sheets(1)
 
xlApp.Visible = True
.ScreenUpdating = False
 
 
wb.Application.DisplayAlerts = False
'This code does the subtotaling
ws.Columns("B").Delete xlShiftToLeft
ws.Range("A1").Select
ws.Cells(1, 1).CurrentRegion.Subtotal GroupBy:=2, Function:=xlSum, _
TotalList:=Array(4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18), Replace:=True, _
PageBreaks:=False, SummaryBelowData:=True
wb.ActiveSheet.Outline.ShowLevels RowLevels:=2
 
wb.Application.DisplayAlerts = True
wb.Close , SaveChanges:=True
Set xlApp = Nothing
End With
End Function