Subtotal macro in each worksheet


K

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?
 
Ad

Advertisements

J

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
 
K

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"
 
D

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
 
K

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.
 
J

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)))
 
Ad

Advertisements

J

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)))
 
D

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.
 
R

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
 
Ad

Advertisements

K

KHogwood-Thompson

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


Roger Govier said:
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

KHogwood-Thompson said:
Neither of those, I am using Excel 2000
 
K

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


Roger Govier said:
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

KHogwood-Thompson said:
Neither of those, I am using Excel 2000
 
Ad

Advertisements

K

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


Roger Govier said:
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

KHogwood-Thompson said:
Neither of those, I am using Excel 2000
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top