Tasfer
Tasfer

Reputation: 71

Add row with value when value changes

I have the below sheet

value1 | value2
001    | car
001    | car1
002    | moto
002    | moto2
003    | ship

I want to insert a blank row when the "value1" changes like this

value1 | value2
001    | car
001    | car1
       |
002    | moto
002    | moto2
       |
003    | ship

And for this I use this code which works fine:

Sub blankRows()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("E" & i).Value <> Range("E" & i - 1).Value Then Rows(i).Insert
Next i
End Sub

What I want is not only to add a blank row, but to the start of the blank row to insert also 10 asterisks. Like this

    value1 | value2
    001    | car
    001    | car1
********** |
    002    | moto
    002    | moto2
********** |
    003    | ship
********** |

Can you please alter my code above to also add 10 asterisks at the blank row it inserts?

Upvotes: 2

Views: 2116

Answers (2)

pnuts
pnuts

Reputation: 59495

VBA is not necessary as Subtotal will achieve much the same, with a little help, and offers automatic grouping, which may or may not be appreciated.

Assuming value1 is in A1, select the two columns, DATA > Outline - Subtotal, At each change in: value1, Use function: Count, Add subtotal to: value1 only checked, check Replace current subtotals and Summary below data), OK. Filter the inserted column to select for Text Filters, Contains..., c, OK and in B1:

**********  

Copy down to suit, delete ColumnA and, if desired, last occupied row.

Upvotes: 0

Raystafarian
Raystafarian

Reputation: 3032

Sub blankRows()
Dim LR As Long, i As Long
LR = Range("E" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("E" & i).Value <> Range("E" & i - 1).Value Then
    Rows(i).Insert
    Cells(i, 1) = "**********"
    End If
Next i
End Sub

Upvotes: 1

Related Questions