How To Auto Insert Rows Based On Criteria?

[NewbieFromNJ]

Hi guys,

Is there a way I can auto insert rows based on the information that is in column B? See attached image. I would like to insert two rows where the item number changes. Example, insert two rows separating 2470 and 2471 and so forth.

Thank you

 

[Joe4]

Welcome to the Board!

In order for VBA code to run automatically, there has to be some "event" that triggers it to run, like the opening of a file, the selection of a particular cell, or the update of a particular cell.
What would be the "event" to automatically trigger the VBA to run in this case?

The other option is to run the VBA code on command.

 

[NewbieFromNJ]

Welcome to the Board!

In order for VBA code to run automatically, there has to be some "event" that triggers it to run, like the opening of a file, the selection of a particular cell, or the update of a particular cell.
What would be the "event" to automatically trigger the VBA to run in this case?

The other option is to run the VBA code on command.

I guess the event could be whatever you recommend is easiest. pressing a button or clicking on a cell will do. I’m open to whatever is simplest to code?

 

[Joe4]

Try this code.
You can assign it to a command button, or keyboard shortcut, if you like:

Sub MyInsertRows()

    Dim lr As Long
    Dim r As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column B with data
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Loop through rows backwards
    For r = lr To 3 Step -1
'       Compare value in column B with value in row above it
        If Cells(r, "B") <> Cells(r - 1, "B") Then
            Rows(r & ":" & r + 1).EntireRow.Insert
        End If
    Next r
        
    Application.ScreenUpdating = True
    
End Sub

 

[NewbieFromNJ]

Try this code.
You can assign it to a command button, or keyboard shortcut, if you like:

Sub MyInsertRows()

    Dim lr As Long
    Dim r As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column B with data
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
'   Loop through rows backwards
    For r = lr To 3 Step -1
'       Compare value in column B with value in row above it
        If Cells(r, "B") <> Cells(r - 1, "B") Then
            Rows(r & ":" & r + 1).EntireRow.Insert
        End If
    Next r
       
    Application.ScreenUpdating = True
   
End Sub

This is my first time working with VBA. I had to research how to add a button and associate code to it, but I didn't screw that part up because your code worked flawlessly! Thank you so much.

Now to understand what the code is doing... where and/or what would I change it if I needed to amend the number of blank rows to add. Let's say, if I'd rather have 1 row inserted instead of two?

 

[Joe4]

where and/or what would I change it if I needed to amend the number of blank rows to add. Let's say, if I'd rather have 1 row inserted instead of two?

For more than two rows, just change the "1" (i.e. 2 would make 3 rows inserted, 3 would make 4, etc).

Rows(r & ":" & r + 1).EntireRow.Insert

For one row, just change that line to this:

Rows(r).EntireRow.Insert