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!

 

[schielrn]

So you want to add 2 blank rows between every non-similiar value?

 

[riaz]

Quick fix, seems to work on my trial sheet.

Select the whole sheet, use Data, Subtotal and do a subtotal or a count, not important what you choose, on Column A when data in column A changes.

Once you have your subtotals, click on level two to hide the data and you should see only lines with subtotals on them.

Select each subtotal individually and insert two rows. While this will be far less than your 4,000 it may be a fair number of manual insertions. You could write a little macro to add the rows for you, once the subtotal view tells you where you need to insert.

Once rows are inserted, get rid of your subtotals.

One caveat - data must be sorted on column A for this to work.

Good luck.

 

[schielrn]

Here is a qucik macro:

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

This assumes your actual data starts in row 2 and the headers are in row 1.

Hope that helps.

 

[VoG]

Try

Sub InsRow()
Dim LR As Long, i As Long
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
End Sub

 

[Peter_SSs]

jamieleeuk

Does this do what you want? (Should be quicker than looping through 4000+ rows)

<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>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> .SpecialCells(xlCellTypeFormulas, xlNumbers)<br>            c.EntireRow.Resize(2).Insert<br>        <SPAN style="color:#00007F">Next</SPAN> c<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Columns("B").Delete<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[jamieleeuk]

Thanks for your replies.

Peter, I'm currently running yours - it's hanging at the minute and has been for the last 4 minutes - but the processor clock shows to be 50% no excel. I will re-post shortly.

Thanks all again.​

 

[jamieleeuk]

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?

 

[jamieleeuk]

Here is a qucik macro:

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

This assumes your actual data starts in row 2 and the headers are in row 1.

Hope that helps.

Hi Schielrn,

Thanks for that but it doens't quite do the trick. It does indeed add 2 blank rows, but it does it after every row of data rather than at the end of a certain group of the same code.
I only want to 2 blank rows to appear between the last row of the previous code and the 1st row of the new code.

Yours does this:

AAL001


AAL001


ABB002


ABB002

Whereas I want it do do this:

AAL001
AAL001


ABB002
ABB002

Thanks

 

[jamieleeuk]

VoG - THANKS VERY MUCH!! YOURS HAS DONE THE TRICK

You have just saved me hours and hours of labourious clicking!

Thanks to everyone who has contributed - much appreciated!