Insert a heading

[dht]

I have this VBA code to insert a line in a spreadsheet everytime a values
changes.

How can I get a heading entered in column E of the inserted line.I thought
it would be relatively easy but obviously not.

col = ActiveCell.Column
lastrow = Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(Cells(1, col).Value) Then
firstrow = Cells(1, col).End(xlDown).Row
Else
firstrow = 1
End If
Set cell = Cells(lastrow, col)
While cell.Row > firstrow + 6
If cell.Value <> cell.Offset(-1, 0).Value Then
cell.EntireRow.Insert
Set cell = cell.Offset(-2, 0)
Else
Set cell = cell.Offset(-1, 0)
End If
Wend

Many thanks
Dave

 

[Tom Ogilvy]

col = ActiveCell.Column
lastrow = Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(Cells(1, col).Value) Then
firstrow = Cells(1, col).End(xlDown).Row
Else
firstrow = 1
End If
Set cell = Cells(lastrow, col)
While cell.Row > firstrow + 6
If cell.Value <> cell.Offset(-1, 0).Value Then
cell.EntireRow.Insert
cells(cell.row-1,"E").Value = "Header"
Set cell = cell.Offset(-2, 0)
Else
Set cell = cell.Offset(-1, 0)
End If
Wend

 

[dht]

Thanks again.
Getting things sorted now.

Dave

col = ActiveCell.Column
lastrow = Cells(Rows.Count, col).End(xlUp).Row
If IsEmpty(Cells(1, col).Value) Then
firstrow = Cells(1, col).End(xlDown).Row
Else
firstrow = 1
End If
Set cell = Cells(lastrow, col)
While cell.Row > firstrow + 6
If cell.Value <> cell.Offset(-1, 0).Value Then
cell.EntireRow.Insert
cells(cell.row-1,"E").Value = "Header"
Set cell = cell.Offset(-2, 0)
Else
Set cell = cell.Offset(-1, 0)
End If
Wend