Macro to insert rows

  • Thread starter Thread starter The Grinch
  • Start date Start date
T

The Grinch

Hi All,

I have a sorted column of data, with repeated data. I want to write
macro that starts at the top of the column and goes down inserting
row when it finds a non duplicated piece of data. EG...

1
1
1
1<---------------Insert row
5
5
5
5<---------------Insert row
10
10<---------------Insert row
62
62
62

Any suggestion/comments would be appreciated.

CHEERS

The Grinc
 
try this. change p to your columns
Sub insertwheredup()
For i = Cells(Rows.Count, "P").End(xlUp).Row To 2 Step -1
If Cells(i, "P") <> Cells(i - 1, "p") Then Rows(i).Insert
Next i
End Sub
 
Grinch

Assuming Column A holds the data.

Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 1) <> Cells(i, 1) Then _
Cells(i, 1).Resize(1, 1).EntireRow.Insert
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub


Gord Dibben Excel MVP
 
I've used the below (above) script which and adjusted it slighly to loo
at the second column. This works if the first (A) is poplated, howeve
if A is empty it stops working... any ideas?

PS, how do I make it insert 2 or more rows?


Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = True
End With
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 2) <> Cells(i, 2) Then _
Cells(i, 1).Resize(1, 1).EntireRow.insert
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Su
 
You're still looking at Column A in your For... statement. Try:

For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1

To get more than one row, change the number of rows in your Resize
method, e.g., for 3 rows:

Cells(i, 1).Resize(3, 1).EntireRow.insert
 
Revised to work on column B and insert two rows.

To insert more than two rows, adjust the resize range as in .Resize(3, 2) or
(4, 2)

Sub InsertRow_At_Change()
Dim i As Long
With Application
.Calculation = xlManual
.ScreenUpdating = False
End With
For i = Cells(Rows.Count, 2).End(xlUp).Row To 2 Step -1
If Cells(i - 1, 2) <> Cells(i, 2) Then _
Cells(i, 2).Resize(2, 2).EntireRow.Insert
Next i
With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
End Sub


Gord
 
Back
Top