Insert a row if there is a value in a column in the row above
 

I have a large spreadsheet (approx. 8500 rows) with four columns.

I would like to insert a new row below any row where there is a value
(entry) in row D.

It is as simple as that, but I can't figure out how to do it...

Thanks

David,

This is a one-time thing. If you run it again, you'll get another empty row
after any cell in column D that isn't empty. Keep an extra copy of your
sheet, or don't save the file if it messes up.

Dim ColumnD As Range
Dim MyCell As Range

Set ColumnD = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each MyCell In ColumnD
If MyCell.Value < "" Then ' is it empty?
MyCell.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown ' insert row
after
End If
Next MyCell
--
Earl Kiosterud
www.smokeylake.com/
-------------------------------------------

"David B" <David wrote in message
...
I have a large spreadsheet (approx. 8500 rows) with four columns.

I would like to insert a new row below any row where there is a value
(entry) in row D.

It is as simple as that, but I can't figure out how to do it...

Thanks

Worked like a charm Earl.

Thanks so much!

Bless you

"Earl Kiosterud" wrote:

David,

This is a one-time thing. If you run it again, you'll get another empty row
after any cell in column D that isn't empty. Keep an extra copy of your
sheet, or don't save the file if it messes up.

Dim ColumnD As Range
Dim MyCell As Range

Set ColumnD = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each MyCell In ColumnD
If MyCell.Value < "" Then ' is it empty?
MyCell.Offset(1, 0).EntireRow.Insert Shift:=xlShiftDown ' insert row
after
End If
Next MyCell
--
Earl Kiosterud
www.smokeylake.com/
-------------------------------------------

"David B" <David wrote in message
...
I have a large spreadsheet (approx. 8500 rows) with four columns.

I would like to insert a new row below any row where there is a value
(entry) in row D.

It is as simple as that, but I can't figure out how to do it...

Thanks