# add a blank row after certain cells



## zack8576 (Jan 4, 2023)

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 (Jan 5, 2023)

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 (Jan 5, 2023)

Joe4 said:


> Try this:
> 
> ```
> Sub MyInsertRows()
> ...


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 (Jan 5, 2023)

zack8576 said:


> 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 (Jan 5, 2023)

Joe4 said:


> Try this version:
> 
> ```
> Sub MyInsertRows()
> ...


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 (Jan 5, 2023)

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 (Jan 5, 2023)

Joe4 said:


> Change this part:
> 
> ```
> For r = lr To *2* Step -1
> ...


thanks, this works perfectly !


----------



## Joe4 (Jan 5, 2023)

You are welcome!
Glad I was able to help.


----------

