insert blank line when text changes

J

jenniwh

Hi, I was wondering if there was a way to write a macro or something else... so while scrolling down a list everytime the text changes (in this case a name) a blank line would be inserted.
 
F

Frank Kabel

Hi
try the following macro. It tests column A and inserts a blank row if
the values change
Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.count, "A").End(xlUp).row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "A").Value <> Cells(row_index + 1, "A").Value
Then
Cells(row_index + 1, "A").EntireRow.Insert (xlShiftDown)
End If
Next
End Sub
 
J

jenniwh

thanks for your re-ply.... I get an error when I try to run: compile error, syntax error ... the sub inser_rows() highlights to yellow and the 'If Cells..... Then' changes to Red.....

Sub insert_rows(
Dim lastrow As Lon
Dim row_index As Lon

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Ro
For row_index = lastrow - 1 To 1 Step -
If Cells(row_index, "A").Value <> Cells(row_index + 1, "A").Valu
The
Cells(row_index + 1, "A").EntireRow.Insert (xlShiftDown
End I
Nex
End Su
 
F

Frank Kabel

Hi
sorry there's a linebreak (due to the newsreader) The If.... and Then
line are ONE line. Combine them or use the following:


Sub insert_rows()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "A").Value <> Cells(row_index + 1, "A"). _
Value Then
Cells(row_index + 1, "A").EntireRow.Insert (xlShiftDown)
End If
Next
End Sub
 
D

Dave Peterson

Frank gave you a nice macro to accomplish this, but I'm not sure I'd use it.

If you insert those extra rows, then it could make processing the list
(filters/pivottables/charts) a little more difficult.

You may want to just double the rowheight of the row. It'll look like it's
double spaced, but your list will still be contiguous.

Stealing from Frank's code:

Option Explicit
Sub DontInsert_rows()
Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
If Cells(row_index, "A").Value <> Cells(row_index + 1, "A").Value Then
Rows(row_index + 1).RowHeight = Rows(row_index + 1).RowHeight * 2
End If
Next
End Sub
 
F

Frank Kabel

Dave said:
Frank gave you a nice macro to accomplish this, but I'm not sure I'd
use it.

If you insert those extra rows, then it could make processing the list
(filters/pivottables/charts) a little more difficult.

You may want to just double the rowheight of the row. It'll look
like it's double spaced, but your list will still be contiguous.

Stealing from Frank's code:

Hi Dave
code was also 'stolen' :)
I like your idea much better than mine!

Frank
 
Top