Insert Blank Row Below Sub-Total?

  • Thread starter Thread starter Miss Jenny
  • Start date Start date
M

Miss Jenny

Is there a more efficient way to insert a blank row after each sub-total line
other than to manually insert each one?
 
You can do it with only one insert command.
But you have to select a single cell in the row below each sub-total line.
Hold the Ctrl key down as you select each cell.
Then on the Insert menu choose 'Rows'.

Also, some VBA code could do it.
--
Jim Cone
Portland, Oregon USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Miss Jenny"
<[email protected]>
wrote in message
Is there a more efficient way to insert a blank row after each sub-total line
other than to manually insert each one?
 
Miss J,
Yes, I do. Sometimes the first version I write even works.
Select a column in the sub-totaled data and run the code below.
Each row in the selected column, that is blank, will have a row inserted above it.
You will not be able to undo the code or remove sub-totals after running the code.
Having a backup copy of the workbook or worksheet is advised.

'--Code starts here--
Sub AddRowsBelowSubtotal()
Dim rng As Range
Dim N As Long
Dim M As Long
Set rng = Selection.Columns(1)
If rng.Cells.Count = 1 Then
MsgBox "Select more than one cell. ", _
vbExclamation, "Blame Jim Cone"
Exit Sub
End If
Set rng = Application.Intersect(ActiveSheet.UsedRange, rng)
Set rng = rng.SpecialCells(xlCellTypeBlanks)
Application.ScreenUpdating = False
M = rng.Areas.Count
For N = M To 1 Step -1
rng.Areas(N).Rows(1).EntireRow.Insert shift:=xlDown
Next
Application.ScreenUpdating = True
MsgBox M & " rows were inserted. ", , "Blame Jim Cone"
Set rng = Nothing
End Sub
'-- Code ends here--
Jim Cone
Portland, Oregon USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Miss Jenny" <[email protected]>
wrote in message
I don't know how to write the VBA code. Do you?
 
This will do what you want:
http://excelusergroup.org/forums/t/538.aspx

I thought I knew hoe to do this, but I just realized that I don't. I
learned something new today. Thanks for asking this question Miss Jenny.


Regards,
Ryan---

--
RyGuy


Jim Cone said:
Miss J,
Yes, I do. Sometimes the first version I write even works.
Select a column in the sub-totaled data and run the code below.
Each row in the selected column, that is blank, will have a row inserted above it.
You will not be able to undo the code or remove sub-totals after running the code.
Having a backup copy of the workbook or worksheet is advised.

'--Code starts here--
Sub AddRowsBelowSubtotal()
Dim rng As Range
Dim N As Long
Dim M As Long
Set rng = Selection.Columns(1)
If rng.Cells.Count = 1 Then
MsgBox "Select more than one cell. ", _
vbExclamation, "Blame Jim Cone"
Exit Sub
End If
Set rng = Application.Intersect(ActiveSheet.UsedRange, rng)
Set rng = rng.SpecialCells(xlCellTypeBlanks)
Application.ScreenUpdating = False
M = rng.Areas.Count
For N = M To 1 Step -1
rng.Areas(N).Rows(1).EntireRow.Insert shift:=xlDown
Next
Application.ScreenUpdating = True
MsgBox M & " rows were inserted. ", , "Blame Jim Cone"
Set rng = Nothing
End Sub
'-- Code ends here--
Jim Cone
Portland, Oregon USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Miss Jenny" <[email protected]>
wrote in message
I don't know how to write the VBA code. Do you?
Click to expand...
 
And this version inserts the row Below each blank cell in the column selected...
'--
Sub AddRowsBelowSubtotal_R1()
Dim rng As Range
Dim N As Long
Dim M As Long
Set rng = Selection.Columns(1)
If rng.Cells.Count = 1 Then
MsgBox "Select more than one cell. ", _
vbExclamation, "Blame Jim Cone"
Exit Sub
End If
Set rng = Application.Intersect(ActiveSheet.UsedRange, rng)
Set rng = rng.SpecialCells(xlCellTypeBlanks)
Application.ScreenUpdating = False
M = rng.Areas.Count
For N = M To 1 Step -1
With rng.Areas(N)
.Rows(.Rows.Count).Offset(1, 0).EntireRow.Insert shift:=xlDown
End With
Next
Application.ScreenUpdating = True
MsgBox M & " rows were inserted. ", , "Blame Jim Cone"
Set rng = Nothing
End Sub
'--
Jim Cone
Portland, Oregon USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)
 
Back
Top