add a blank row after certain cells

[zack8576]

I need to add a blank row before when value in B changes, in the example file below, a blank row will need to be added after the highlighted cells.
How do I approach this issue with VBA? Note: the value in column B can be any length, sometimes it is just a number, sometimes it is a combination of text + number.

 

[Joe4]

Try this:

Sub MyInsertRows()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if value is different from the row above
        If Cells(r, "B").Value <> Cells(r - 1, "B").Value Then
'           Insert row
            Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[zack8576]

Try this:

Sub MyInsertRows()

    Dim lr As Long, r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if value is different from the row above
        If Cells(r, "B").Value <> Cells(r - 1, "B").Value Then
'           Insert row
            Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        End If
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

thank you
what if I need to make sure all these added rows have the same value in column A as any other row?
in my example, that would be CF26823

 

[Joe4]

thank you
what if I need to make sure all these added rows have the same value in column A as any other row?
in my example, that would be CF26823

Try this version:

Sub MyInsertRows()

    Dim lr As Long, r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if value is different from the row above
        If Cells(r, "B").Value <> Cells(r - 1, "B").Value Then
'           Insert row
            Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'           Copy value from row A above
            Cells(r, "A").Value = Cells(r - 1, "A").Value
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[zack8576]

Try this version:

Sub MyInsertRows()

    Dim lr As Long, r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if value is different from the row above
        If Cells(r, "B").Value <> Cells(r - 1, "B").Value Then
'           Insert row
            Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'           Copy value from row A above
            Cells(r, "A").Value = Cells(r - 1, "A").Value
        End If
    Next r
   
    Application.ScreenUpdating = True
   
End Sub

thank you, one last question. The code adds a row after row 1.
What if I want this code to execute from row 2 to last row, would you modify the code like so ?

    lr = Cells(Rows.Count, "B2:B").End(xlUp).Row
'   Loop through all rows backwards
    For r = lr To 2 Step -1
'       Check to see if value is different from the row above
        If Cells(r, "B2:B").Value <> Cells(r - 1, "B2:B").Value Then
'           Insert row
            Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'           Copy value from row A above
            Cells(r, "A").Value = Cells(r - 1, "A").Value
        End If
    Next r

 

[Joe4]

Change this part:

   For r = lr To 2 Step -1

to this:

   For r = lr To 3 Step -1

Then it won't compare row 2 to row 1 and will stop with comparing row 3 to row 2 (remember we are working backwards, from the bottom to the top).

 

[zack8576]

Change this part:

   For r = lr To 2 Step -1

to this:

   For r = lr To 3 Step -1

Then it won't compare row 2 to row 1 and will stop with comparing row 3 to row 2 (remember we are working backwards, from the bottom to the top).

thanks, this works perfectly !

 

[Joe4]

You are welcome!
Glad I was able to help.