Insert Blank Row when Cell Value changes

[ultracyclist]

In Column B, I have repeating cell values. I would l like to insert a blank row whenever the value changes.


I found the following code which targets only a single value. I tried modifying this to meet my needs, but not sure.

Sub InsertRows()
Dim i As Long
i = 2
Do Until Trim(Cells(i, 1)) = ""
If Cells(i, 1) = "991CX" Then
Cells(i, 1).EntireRow.Insert
i = i + 2
Else
i = i + 1
End If
Loop
End Sub<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p></o:p>
<o:p>

</o>
<o></o>
<o></o>
<o>Any thoughts?</o>
<o></o>
<o>Thanks,</o>
<o></o>
<o>Allen</o>

 

[Matt Rogers]

Hi Allen.

Try this Macro:

Sub BlankRow()
Dim change As Range
Set change = ActiveSheet.UsedRange
For i = change.Rows.Count To 2 Step -1
If Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
Rows(i).Insert Shift:=xlDown
End If
Next
End Sub

 

[Rick Rothstein]

This macro should do what you want...

Sub InsertRowsAtValueChangeColumnB()
  Dim X As Long, LastRow As Long
  Const DataCol As String = "B"
  Const StartRow = 2
  LastRow = Cells(Rows.Count, DataCol).End(xlUp).Row
  Application.ScreenUpdating = False
  For X = LastRow To StartRow + 1 Step -1
    If Cells(X, DataCol).Value <> Cells(X - 1, DataCol) Then Rows(X).Insert
  Next
  Application.ScreenUpdating = True
End Sub

Note: Make sure the StartRow constant (in the Const statement) is set to the correct starting row number for your data (I assumed 2 in my code above).

 

[ultracyclist]

Matt/Rick,

Thank you for your examples, both worked perfectly.

Regards,

Allen.