blank line before a subtotal

[rshintz]

I need to insert a blank row before a subtotal, can you help.

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6, 7), _
Replace:=True, PageBreaks:=True, SummaryBelowData:=True

 

[Boller]

Dim lr&, lc&, rng As Range
ActiveSheet.UsedRange
lr = [A1].End(xlDown).Row
lc = [A1].End(xlToRight).Column
Set rng = Range([A1], Cells(lr, lc))
rng.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6, 7), _
    Replace:=True, PageBreaks:=True, SummaryBelowData:=True
[A1].End(xlDown).EntireRow.Insert
Range([B1], [A1].End(xlDown)(1, 2)).SpecialCells(xlCellTypeBlanks).EntireRow.Insert

If you remove the sub-totals, the blank rows will remain - so you will need to remove them before running the code again.

 

[rshintz]

Thank you for your time, however I was able to work it out and found this much easier.

Sub b3rows()
Dim a As Long
For a = Cells(rows.Count, "A").End(xlUp).row To 2 Step -1
If Cells(a, "A").Value <> Cells(a - 1, "A").Value Then rows(a & ":" & a).Insert
Next a
End Sub

 

[Boller]

Thank you for your time, however I was able to work it out and found this much easier.

Sub b3rows()
Dim a As Long
For a = Cells(rows.Count, "A").End(xlUp).row To 2 Step -1
If Cells(a, "A").Value <> Cells(a - 1, "A").Value Then rows(a & ":" & a).Insert
Next a
End Sub

"I was able to work it out"

You worked that out? Well, it's a long way from the sort of code structure you posted.

I cannot see why you think that what you've "worked out" is easier than what I suggested :-

[A1].End(xlDown).EntireRow.Insert
Range([B1], [A1].End(xlDown)(1, 2)).SpecialCells(xlCellTypeBlanks).EntireRow.Insert

Also, your code is not as efficient as mine (no looping required with my code).

Also, you have switched to using .End(xlUp) instead of .End(xlDown)
Why is that? Have your requirements in this respect changed since your first post?