Add Rows at Specific Points

[jamieleeuk]

Please see the below image of a spreadsheet i'm working on.
There's roughly 4000 rows of data and if there's not a quick fix with VBA then i'm going to be spending hours manually adding rows.

Column B houses the Group Code, what I need to do is add 2 blank rows between each group code making sure the data stays relevant to the code it is next to currently.

So looking at the pic below, I would want something like this:

BAE001
blank
blank
BAL001
BAL001
blank
blank
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
BAL007
blank
blank

and so on.

My question is, is there something which will do that for me instead of me manually looking for the change in Code and then inserting rows one by one?

Please if you need more info, I will happily supply it!

 

[Peter_SSs]

Peter,

Your's put 2 blanks between the first 3 IE

AAL001
AAL001


ABB002
ABB002
ABB002


ABB003

But for some reason, after the ABB003, it moved the rest of them down to the bottom with the next code ABB004 starting on row 63,657 and none of the subsequent rows were split - any ideas?

I don't think I tested with enough different circumstances (and I still might not have), but you could try this one instead. It may still take a while to execute with so many rows. You might want to rest with a smaller data set first.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Insert2Blanks()<br>    <SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Columns("B").Insert<br>    <SPAN style="color:#00007F">With</SPAN> Range("B3", Range("C" & Rows.Count).End(xlUp).Offset(, -1))<br>        .FormulaR1C1 = "=IF(RC[1]=R[-1]C[1],"""",1)"<br>        .Value = .Value<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Columns("B")<br>         <SPAN style="color:#00007F">Set</SPAN> c = .Find(What:=1, After:=.Cells(1, 1), LookIn:=xlValues, _<br>            Lookat:=xlWhole, Searchformat:=False)<br>         <SPAN style="color:#00007F">Do</SPAN><br>            c.Clear<br>            c.EntireRow.Resize(2).Insert<br>            <SPAN style="color:#00007F">Set</SPAN> c = .FindNext(After:=c)<br>         <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> <SPAN style="color:#00007F">Not</SPAN> c <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Columns("B").Delete<br>    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[schielrn]

oops, changed a number where it was suppose to be 1 and another number where it was suppose to be 2. Mine is the same as Vog's, just I did not declare my variables. Here is the correct version, but as I said it is the same as Vog's.

Sub test()
For i = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1
    If Cells(i, 2).Value <> Cells(i - 1, 2).Value Then Rows(i).Resize(2).Insert
Next i
End Sub

Thanks.

 

[VoG]

This would speed mine up

Sub InsRow()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 3 Step -1
    If Range("B" & i).Value <> Range("B" & i - 1).Value Then Rows(i).Resize(2).Insert
Next i
Application.ScreenUpdating = trye
Application.Calculation = xlCalculationAutomatic
End Sub

 

[jamieleeuk]

It was PDQ to begin with in all honesty. Took about 10 seconds!