Subtotal macro in each worksheet

[KHogwood-Thompson]

I have a workbook containing several worksheets, I wish to perform a subtotal
on each worksheet. Each worksheet is setup identical in terms of the number
of columns and colum titles etc but differ in the number of rows containing
data.

I am using the following code:

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Next

I get an error message saying that saying:

"Subtotal method Of Range class failed"

Can anyone advise?

 

[Joel]

You ned to include the worksheet in the ranges

For Each ws In ActiveWorkbook.Worksheets
ws.Range("A1").Select
ws.Range(Selection, Selection.End(xlToRight)).Select
ws.Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=10, Function:=xlSum, TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Next

or

For Each ws In ActiveWorkbook.Worksheets
set Lastcol = .Range("A1).end(xltoRight)
set LastCell = LastCol.end(xldown)
Set SubtotalRange = .Range(.Range("A1"),LastCell)
SubtotalRange.Subtotal GroupBy:=10, Function:=xlSum,
TotalList:=Array(13), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Next

 

[KHogwood-Thompson]

Thanks for your post Joel, however I have tried both methods that you posted
and both of them result in the same error:

"Subtotal method Of Range class failed"

 

[Don Guillett]

Try This idea to put the sum below the last row

Sub SubTotalEachSht()
For Each ws In Worksheets
With ws
lc = .Cells(1, 1).End(xlToRight).Column
lr = .Cells(Rows.Count, lc).End(xlUp).Row
.Cells(lr + 1, lc).Value = _
Application.Sum(Range(.Cells(2, lc), .Cells(lr, lc)))
End With
Next ws
End Sub

 

[KHogwood-Thompson]

Don,

Yes this works, but does not perform the subtotal as required, on each sheet
I have transactions that need to be grouped and subtotalled by a column
called "HEAD". Your method does sum a column but is not the correct column
and only performs a grand total.

 

[Joel]

Try Don's code again but make one minor change
from
Application.Sum(Range(.Cells(2, lc), .Cells(lr, lc)))
to
Application.Sum(.Range(.Cells(2, lc), .Cells(lr, lc)))

 

[KHogwood-Thompson]

Hi Joel,

Code does the same as Don's.

 

[Joel]

Do you have Excell 2003 or Excel 2007. If 2003 make this change

from
Application.Sum(.Range(.Cells(2, lc), .Cells(lr, lc)))

to
worksheetfunction.Sum(.Range(.Cells(2, lc), .Cells(lr, lc)))

 

[Don Guillett]

Based on Joel's catch, I think it did what your OP asked for. If desired,
send to my address below, your workbook
along with clear explanation of what you want and before/after example.

 

[KHogwood-Thompson]

Neither of those, I am using Excel 2000

 

[Roger Govier]

Hi

I just tested the following in XL2000 and it works fine for me.
I also include some code to remove Subtotals on all sheets.

Sub Subtotals()
Dim lc As Long, lr As Long, ws As Worksheet
Dim myRng As Range

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
lc = ws.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
lr = ws.Cells(Rows.Count, lc).End(xlUp).Row
Set myRng = ws.Range(Cells(1, 1), Cells(lr, lc))
myRng.Subtotal GroupBy:=10, Function:=xlSum, _
TotalList:=Array(13), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True
Next ws

End Sub

Sub RemoveSubtotals()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").RemoveSubtotal
Next ws

End Sub

 

[KHogwood-Thompson]

Thanks Roger, but unfortunately I sill get the same error.
--
K Hogwood-Thompson

Hi

I just tested the following in XL2000 and it works fine for me.
I also include some code to remove Subtotals on all sheets.

Sub Subtotals()
Dim lc As Long, lr As Long, ws As Worksheet
Dim myRng As Range

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
lc = ws.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
lr = ws.Cells(Rows.Count, lc).End(xlUp).Row
Set myRng = ws.Range(Cells(1, 1), Cells(lr, lc))
myRng.Subtotal GroupBy:=10, Function:=xlSum, _
TotalList:=Array(13), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True
Next ws

End Sub

Sub RemoveSubtotals()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").RemoveSubtotal
Next ws

End Sub


--
Regards
Roger Govier

Neither of those, I am using Excel 2000

 

[KHogwood-Thompson]

I have opened the Help on Excel and there is something about using range on
cells that do not contain data, I am wondering if this is the reason for the
error as there is one column on each worksheet in my workbook that does not
contain data.
--
K Hogwood-Thompson

Hi

I just tested the following in XL2000 and it works fine for me.
I also include some code to remove Subtotals on all sheets.

Sub Subtotals()
Dim lc As Long, lr As Long, ws As Worksheet
Dim myRng As Range

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
lc = ws.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
lr = ws.Cells(Rows.Count, lc).End(xlUp).Row
Set myRng = ws.Range(Cells(1, 1), Cells(lr, lc))
myRng.Subtotal GroupBy:=10, Function:=xlSum, _
TotalList:=Array(13), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True
Next ws

End Sub

Sub RemoveSubtotals()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").RemoveSubtotal
Next ws

End Sub


--
Regards
Roger Govier

Neither of those, I am using Excel 2000

 

[KHogwood-Thompson]

I have resolved the problem with the following code:

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
ws.Columns("A:K").Select
Selection.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(10, 11), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True

It seems that making the columns explicit in the code does the trick!
--
K Hogwood-Thompson

Hi

I just tested the following in XL2000 and it works fine for me.
I also include some code to remove Subtotals on all sheets.

Sub Subtotals()
Dim lc As Long, lr As Long, ws As Worksheet
Dim myRng As Range

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
lc = ws.Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
lr = ws.Cells(Rows.Count, lc).End(xlUp).Row
Set myRng = ws.Range(Cells(1, 1), Cells(lr, lc))
myRng.Subtotal GroupBy:=10, Function:=xlSum, _
TotalList:=Array(13), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True
Next ws

End Sub

Sub RemoveSubtotals()
Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Range("A1").RemoveSubtotal
Next ws

End Sub


--
Regards
Roger Govier

Neither of those, I am using Excel 2000