Hi all,

When creating subtotals, Excel doesn't put in blank rows after each grouping. I have created a macro which would essentially take data that I collect on a monthly basis and create subtotals on certain columns and group them by a change in the Company name. What I need to include in that is the ability to separate the subtotal groups by a blank row. This is what I have thus far what would I need to add at the end of the code to insert a blank row before displaying the next subtotal group?:

Range("A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Columns.AutoFit
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(10, 11, 12 _
, 13, 14, 15, 16, 17, 18, 19, 20), Replace:=True, PageBreaks:=False, SummaryBelowData:= _
True
Range("A3").Select

Thanks for any and all help

Hello Haas,

Try the code below. It seemed to work for me.

Hope this helps,

Ben

Sub AddSubTotalRow()
Dim rValues As Range
Dim c As Range
Dim lRow(1 To 2) As Long
Dim strArray As String

Set rValues = Range("A3").CurrentRegion
With rValues
.Columns.AutoFit
Application.CutCopyMode = False
lRow(1) = .Rows.Count
.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(10, 11, 12 _
, 13, 14, 15, 16, 17, 18, 19, 20), Replace:=True, PageBreaks:=False, SummaryBelowData:= _
True
lRow(2) = .CurrentRegion.Rows.Count
If lRow(2) = lRow(1) Then Exit Sub 'user cancelled sub-total, so exit
Set rValues = .Resize(lRow(2), 3)
End With

For Each c In rValues
If Right(c.Value, 5) = "Total" Then
strArray = strArray & ", " & c.Address
End If
Next c

strArray = Right(strArray, Len(strArray) - 2)
Set rValues = Range(strArray).Offset(1, 0)
rValues.EntireRow.Insert


Set rValues = Nothing

End Sub

On Tuesday, October 16, 2012 11:18:58 PM UTC-4, Ben McClave wrote:
Hello Haas,



Try the code below. It seemed to work for me.



Hope this helps,



Ben



Sub AddSubTotalRow()

Dim rValues As Range

Dim c As Range

Dim lRow(1 To 2) As Long

Dim strArray As String



Set rValues = Range("A3").CurrentRegion

With rValues

.Columns.AutoFit

Application.CutCopyMode = False

lRow(1) = .Rows.Count

.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(10, 11, 12 _

, 13, 14, 15, 16, 17, 18, 19, 20), Replace:=True, PageBreaks:=False, SummaryBelowData:= _

True

lRow(2) = .CurrentRegion.Rows.Count

If lRow(2) = lRow(1) Then Exit Sub 'user cancelled sub-total, so exit

Set rValues = .Resize(lRow(2), 3)

End With



For Each c In rValues

If Right(c.Value, 5) = "Total" Then

strArray = strArray & ", " & c.Address

End If

Next c



strArray = Right(strArray, Len(strArray) - 2)

Set rValues = Range(strArray).Offset(1, 0)

rValues.EntireRow.Insert





Set rValues = Nothing



End Sub

Excellent - thanks much!