Subtotal

[YellowShaftedFlicker]

Excel 2002
When using Data, Subtotals, is there any way to get it to insert an empty
row after each subtotal?

 

[CLR]

You'll need VBA to do that.........here's one version, but it must be "tuned"
to each application.........

Sub AddRowSubTotals()
'Adds blank rows to the Sub-totaled sheet for easier reading
'Also changes font on the first 30 columns from the left to BOLD
Dim lastrow As Long
Dim r As Long
lastrow = Range("X" & Rows.Count).End(xlUp).Row
For r = lastrow To 2 Step -1
If InStr(1, Cells(r, 3).Value, "Total") > 0 Or _
InStr(1, Cells(r, 8).Value, "Total") > 0 Or _
InStr(1, Cells(r, 14).Value, "Total") > 0 Then
Range(Cells(r, 1), Cells(r, 30)).Font.Bold = True '30 is number
'of columns from "A" that the macro will BOLD
ActiveSheet.Rows(r + 1).EntireRow.Insert

End If
Next
End Sub

Vaya con Dios,
Chuck, CABGx3

 

[Dave Peterson]

I don't like inserting additional rows--I think they cause more trouble than
they're worth.

And if you only want this to look like double spaced rows, you can do:

Apply your data|subtotals
use the outline symbols on the left to hide the details
select the range
edit|goto|special|visible cells only

And adjust the row height for those rows that are still selected.

 

[Dave Peterson]

Ps. After you select the visible cells.
Format|Row|Height|and double it

And with just the subtotals selected
format|cells|alignment tab|Vertical box|Top

 

[CLR]

I don't like inserting additional rows--I think they cause more trouble than
they're worth.

Yeah, I hear ya Dave, and normally would agree. In my personal case I do
prefer the added rows because they can be inserted with a "pushbutton" by the
User, or automatically along with the "Subtotal macro", and are for
formatting the dataset for printout only and no further manipulation of the
dataset will be performed. My dataset is created by macro and the old one is
deleted each time a new one is generated......so the old one don't hang
around to be messed with. However, if your "row height" method could be
macroized, I would probably lean toward it for future use myself.

Vaya con Dios,
Chuck, CABGx3

 

[Dave Peterson]

I just record a macro when I do it manually.

Since all this stuff is being created by a macro, it shouldn't be too difficult
to merge the additional code into the existing code????

 

[CLR]

Sounds cool........some of "that stuff" don't take to recording too good tho
sometimes, but I'll give it a try when I get a chance........

Thanks,
Vaya con Dios,
Chuck, CABGx3

 

[CLR]

Hmmmmmm, just as I feared, my XL97 would not record those actions.....too
bad, seemed like a good idea.

Vaya con Dios,
Chuck, CABGx3

 

[Dave Peterson]

I'm very surprised that xl97 doesn't record those actions. I'm sure I used this
technique and I know that I rely on that recorder for syntax--even back with
xl97.

This is what I got with xl2003--maybe you can tweak it.

Range("A1:I31").Select
Selection.Subtotal GroupBy:=1, Function:=xlCount, _
TotalList:=Array(7, 8, 9), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Range("A3:I62").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.RowHeight = 33
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveSheet.Outline.ShowLevels RowLevels:=3

I'd tweak it like:

Option Explicit
Sub testme()

Dim myRng As Range
Dim myVRng As Range
Dim LastRow As Long
Dim LastCol As Long

With Worksheets("sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

Set myRng = .Range("a1", .Cells(LastRow, LastCol))

myRng.Subtotal GroupBy:=1, Function:=xlCount, _
TotalList:=Array(7, 8, 9), Replace:=True, PageBreaks:=False, _
SummaryBelowData:=True

.Outline.ShowLevels RowLevels:=2

With myRng
Set myVRng = .Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With

With myVRng
.EntireRow.RowHeight = 25
.VerticalAlignment = xlTop
End With

.Outline.ShowLevels RowLevels:=3
End With
End Sub

But you're going to have to do the subtotals--I have no idea what they should
be.

 

[CLR]

Thanks Dave..........I'll give it a shot tomorrow where I have the file at
work. I already have the Subtotal part, so from what I see it should be
doable for me to be able to cut it in.......I'll let you know how it
goes..............thanks for the help!

Vaya con Dios,
Chuck, CABGx3

 

[CLR]

Hi Dave........
I just don't seem to be able to get it together. It all seems to work, but
for some reason skips the top two groups.........then goes on to perform as
expected, increasing the height of the subtotal rows as desired and placing
the values at the top of those cells.

Here's the code with the mods for my application.......if you see anything
that might be causing what I've described, please holler....

Sub testme()
Dim myRng As Range
Dim myVRng As Range
Dim LastRow As Long
Dim LastCol As Long
With Worksheets("MonthlyReport") 'chd to my worksheet, was Sheet1
LastRow = .Cells(.Rows.Count, "h").End(xlUp).Row 'chd to column
where grand total is (was A)
LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column 'chd to row
7 as ref instead of row 1
Set myRng = .Range("a7", .Cells(LastRow, LastCol)) 'chd to just
above freeze line, was A1
'=====================================================
'deleted Dave's 3 rows and added my subtotal stuff
' myRng.Subtotal GroupBy:=1, Function:=xlCount, _
' TotalList:=Array(7, 8, 9), Replace:=True, PageBreaks:=False, _
' SummaryBelowData:=True
myRng.ClearOutline
myRng.sort Key1:=Range("h8"), Order1:=xlAscending, Key2:=Range("B8") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
myRng.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(15, 16, 17,
18, 19, 22, 23, 24), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'=====================================================
.Outline.ShowLevels RowLevels:=2
With myRng
Set myVRng = .Resize(.Rows.Count - 1).Offset(7, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
With myVRng
.EntireRow.RowHeight = 50
.VerticalAlignment = xlTop
End With
.Outline.ShowLevels RowLevels:=3
End With
End Sub

thanks,
Vaya con Dios,
Chuck, CABGx3

Thanks Dave..........I'll give it a shot tomorrow where I have the file at
work. I already have the Subtotal part, so from what I see it should be
doable for me to be able to cut it in.......I'll let you know how it
goes..............thanks for the help!

Vaya con Dios,
Chuck, CABGx3

 

[Dave Peterson]

I'd check to see what this refers to:

Set myVRng = .Resize(.Rows.Count - 1).Offset(7, 0) _
.Cells.SpecialCells(xlCellTypeVisible)

maybe just

msgbox myvrng.address

will give you a hint (that .offset(7,0) looks suspicious to me).

Hi Dave........
I just don't seem to be able to get it together. It all seems to work, but
for some reason skips the top two groups.........then goes on to perform as
expected, increasing the height of the subtotal rows as desired and placing
the values at the top of those cells.

Here's the code with the mods for my application.......if you see anything
that might be causing what I've described, please holler....

Sub testme()
Dim myRng As Range
Dim myVRng As Range
Dim LastRow As Long
Dim LastCol As Long
With Worksheets("MonthlyReport") 'chd to my worksheet, was Sheet1
LastRow = .Cells(.Rows.Count, "h").End(xlUp).Row 'chd to column
where grand total is (was A)
LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column 'chd to row
7 as ref instead of row 1
Set myRng = .Range("a7", .Cells(LastRow, LastCol)) 'chd to just
above freeze line, was A1
'=====================================================
'deleted Dave's 3 rows and added my subtotal stuff
' myRng.Subtotal GroupBy:=1, Function:=xlCount, _
' TotalList:=Array(7, 8, 9), Replace:=True, PageBreaks:=False, _
' SummaryBelowData:=True
myRng.ClearOutline
myRng.sort Key1:=Range("h8"), Order1:=xlAscending, Key2:=Range("B8") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
myRng.Subtotal GroupBy:=8, Function:=xlSum, TotalList:=Array(15, 16, 17,
18, 19, 22, 23, 24), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'=====================================================
.Outline.ShowLevels RowLevels:=2
With myRng
Set myVRng = .Resize(.Rows.Count - 1).Offset(7, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
With myVRng
.EntireRow.RowHeight = 50
.VerticalAlignment = xlTop
End With
.Outline.ShowLevels RowLevels:=3
End With
End Sub

thanks,
Vaya con Dios,
Chuck, CABGx3

 

[CLR]

Heh-heh.........that was a leftover attempt at modifying your code to fit my
application, I was trying to clear my freeze line at row 7.....changing back
to

Set myVRng = .Resize(.Rows.Count - 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)

like you had it originally made all the lions and tigers go away..........

Thanks very much Dave, I really appreciate the help, and this is much nicer
than adding rows to make the Subtotal readout more legible.

Vaya con Dios,
Chuck, CABGx3

 

[Dave Peterson]

Those extra rows can make everything a little more difficult.

Glad you got it working.