Insert Row VBA

[rusted314]

I have report that I am adding subtotals to using the Excel 2010 subtotal feature. I now need to add a row before and after each subtotal which is column E in my document. Below is an example. Does anyone have a simple macro that will do this?

100</SPAN>	111</SPAN>	2/8/2013</SPAN>
100 Total</SPAN>
105</SPAN>	100</SPAN>	2/28/2013</SPAN>
105</SPAN>	313</SPAN>	2/7/2013</SPAN>

<TBODY>
</TBODY>

 

[Smitty]

If you do that you'll lose the Sub-Total functionality unless you remove those rows.

 

[rusted314]

It allows me to manually add a row before and a row after?

 

[Smitty]

What I mean is that if you add rows like that then the sheet will be seen as a series of different data ranges, and no longer contiguous. The Sub-Total function needs a contiguous data range.

 

[jim may]

With a sample Table like so...

Excel 2010

	A	B	C	D
1	Dept	Code	Revenue	Select
2	70	1895	52.00	y
3	70	1756	75.00	n
4	70	1325	82.00	n
5	70	1111	-	n
6	70	2222	15.00	n
7	70 Total		224.00
8	71	1895	16.00	y
9	71	1777	17.00	n
10	71	1756	18.00	y
11	71	1325	19.00	n
12	71	1111	20.00	n
13	71	2222	21.00	y
14	71	1998	22.00	n
15	71 Total		133.00
16	100	1895	23.00	y
17	100	1777	24.00	y
18	100	1756	25.00	n
19	100	1325	26.00	n
20	100	1111	27.00	y
21	100	2222	28.00	n
22	100	1998	29.00	y
23	100 Total		182.00
24	Grand Total		539.00

<colgroup><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Run this code against...

Sub Foo()
With Application
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
LR = Range("A" & Rows.Count).End(xlUp).Row - 1
For i = LR To 1 Step -1
    If InStr(1, Cells(i, 1), "Total", vbTextCompare) Then
        Cells(i, 1).Offset(1).EntireRow.Insert
        Cells(i, 1).EntireRow.Insert
    End If
Next i
With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

 

[rusted314]

Unfortunately the VBA didnt work but I appreciate you sharing it with me. Yes, my table is setup very similiar to yours example except my totals are in column E and I am sub totaling columns H and I. To Smittys point maybe this cant be done using the subtotal feature or maybe i need a macro to do the subtotals for me?

 

[rusted314]

I ended up finding a macro online that I was able to modify that did the trick. Thank you all for your help.

Sub InsertRows()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("E" & Rows.Count).End(xlUp).Row
For r = m To 1 Step -1
If Range("E" & r) Like "*Total" Then
Range("E" & (r + 1)).EntireRow.Insert

End If

If Range("E" & r) Like "*Total" Then
Range("E" & r).EntireRow.Insert

End If

Next r
Application.ScreenUpdating = True
End Sub