Insert Blank Rows

[igbert]

How do I insert one or multiple blanks rows after each type of data? The
insert criteria is based on the data in Column D, not column A.

Cloumn A B C D E

28FEB07 2006 Q1-Q4 Charge 23.39
31MAR07 2006 Q1-Q4 Charge 23.39
30APR07 2006 Q1-Q4 Charge 30.04
31MAY07 2006 Q1-Q4 Charge 30.04
30JUN07 2006 Q1-Q4 Charge 30.04
31JUL07 2006 Q1-Q4 Charge 30.04
31AUG07 2006 Q1-Q4 Charge 30.04
30SEP07 2006 Q1-Q4 Charge 30.04
29FEB08 2007 Q1-Q4 Charge 8.37
09MAY08 2008 Q1-Q4 Interest 38.69
13JUN08 2008 Q1-Q4 Interest 48.63
11JUL08 2008 Q1-Q4 Interest 49.58
15AUG08 2008 Q1-Q4 Interest 45.61
12SEP08 2008 Q1-Q4 Interest 42.61
10OCT08 2008 Q1-Q4 Interest 46.19
07NOV07 2006 Q1-Q4 Interest 487.01
26AUG08 2007 Q1-Q4 Interest 422.9
16DEC05 2005 Q1-Q4 Principal 300
26SEP06 2006 Q1-Q4 Principal 1751.34
26SEP06 2006 Q1-Q4 Principal 588.15
06NOV07 2007 Q3 Principal 836.74
26AUG08 2008 Q1 Principal 568.13
26AUG08 2008 Q2 Principal 740.34

 

[Mike H]

Hi,

Right click your sheet tab, view code and paste this and run it.

Sub insertem()
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For x = lastrow To 2 Step -1
If Cells(x, 4).Value <> Cells(x, 4).Offset(-1, 0).Value Then
Rows(x).EntireRow.Insert
End If
Next
End Sub

Mike

 

[Mike H]

Just noticed you wanted to insert variable rows. try this instead

Sub insertem()
numrows = InputBox("How many rows to insert?")
If Not IsNumeric(numrows) Then Exit Sub
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For x = lastrow To 2 Step -1
If Cells(x, 4).Value <> Cells(x, 4).Offset(-1, 0).Value Then
For i = 1 To numrows
Rows(x).EntireRow.Insert
Next
End If
Next
End Sub

Mike

 

[Sheeloo]

Use this macro on acitve sheet
See comments within the code

Sub insertblankrows()
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Key = .Cells(lastRow, 4).Value
lastRow = lastRow - 1

'Change 2 to 1 if you don't have header row
For i = lastRow To 2 Step -1
If .Cells(i, 4).Value <> Key Then
'Change 1:1 to 1:2 if you want to insert two rows each
Cells(i + 1, 1).Rows("1:1").EntireRow.Insert
Key = .Cells(i, 4).Value
End If
Next i
End With
End Sub

 

[Gord Dibben]

Sub InsertRow_At_Change()
'Sandy Mann July 1st, 2007
Dim LastRow As Long
Dim X As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For X = LastRow To 3 Step -1
If Cells(X, 4).Value <> Cells(X - 1, 4).Value Then
If Cells(X, 4).Value <> "" Then
If Cells(X - 1, 4).Value <> "" Then
Cells(X, 4).EntireRow.Insert Shift:=xlDown
End If
End If
End If
Next X
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP

 

[igbert]

Thanks,

Your answer works perfect. It is flexible to add whatever row(s) I want.
Many thanks for the great solution.

Igbert