Adding specific number of rows

[andre30331]

Hi all – I cannot seems to find anything to fit my situation and everything I’ve tried so far has failed. I'm looking for a macro that will look at the values in column E that have different ID values that should be in minimum quantities of 26 for each unique ID.

In the case where there are less than 26 records for an ID I would the script to add the missing number of rows to meet the 26 item requirement. So if ID 30 only has ten (10) records the script would then add sixteen (16) rows for that record and so on. In the case where there are more than 26 rows for an individual ID I would like to script to insert one row after the last one in that group and contain the text “Max ID’s exceeded”. Is this possible?

Thanks in advance,

 

[Akuini]

Try this:
Assuming there are headers at row 1.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1083483b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1083483-adding-specific-number-rows.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] m [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"E"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
z = [COLOR=crimson]26[/COLOR]

[COLOR=Royalblue]For[/COLOR] i = n [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
    tx = Cells(i, [COLOR=brown]"E"[/COLOR])
    
    q = Range([COLOR=brown]"E:E"[/COLOR]).Find(tx, lookAt:=xlWhole, SearchDirection:=xlNext).Row
    k = i - q + [COLOR=crimson]1[/COLOR]
    
    [COLOR=Royalblue]If[/COLOR] k > z [COLOR=Royalblue]Then[/COLOR]
        Rows(i + [COLOR=crimson]1[/COLOR]).Insert Shift:=xlShiftDown
        Cells(i + [COLOR=crimson]1[/COLOR], [COLOR=brown]"E"[/COLOR]) = [COLOR=brown]"Max ID’s exceeded"[/COLOR]
    [COLOR=Royalblue]ElseIf[/COLOR] k < z [COLOR=Royalblue]Then[/COLOR]
        Rows(i + [COLOR=crimson]1[/COLOR] & [COLOR=brown]":"[/COLOR] & i + z - k).Insert Shift:=xlShiftDown
        Intersect(Columns([COLOR=brown]"E:E"[/COLOR]), Rows(i + [COLOR=crimson]1[/COLOR] & [COLOR=brown]":"[/COLOR] & i + z - k)).Value = tx
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

    i = q
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

 

[andre30331]

Try this:
Assuming there are headers at row 1.

[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1083483b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1083483-adding-specific-number-rows.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] m [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] tx [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]String[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
n = Range([COLOR=brown]"E"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
z = [COLOR=crimson]26[/COLOR]

[COLOR=Royalblue]For[/COLOR] i = n [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
    tx = Cells(i, [COLOR=brown]"E"[/COLOR])
    
    q = Range([COLOR=brown]"E:E"[/COLOR]).Find(tx, lookAt:=xlWhole, SearchDirection:=xlNext).Row
    k = i - q + [COLOR=crimson]1[/COLOR]
    
    [COLOR=Royalblue]If[/COLOR] k > z [COLOR=Royalblue]Then[/COLOR]
        Rows(i + [COLOR=crimson]1[/COLOR]).Insert Shift:=xlShiftDown
        Cells(i + [COLOR=crimson]1[/COLOR], [COLOR=brown]"E"[/COLOR]) = [COLOR=brown]"Max ID’s exceeded"[/COLOR]
    [COLOR=Royalblue]ElseIf[/COLOR] k < z [COLOR=Royalblue]Then[/COLOR]
        Rows(i + [COLOR=crimson]1[/COLOR] & [COLOR=brown]":"[/COLOR] & i + z - k).Insert Shift:=xlShiftDown
        Intersect(Columns([COLOR=brown]"E:E"[/COLOR]), Rows(i + [COLOR=crimson]1[/COLOR] & [COLOR=brown]":"[/COLOR] & i + z - k)).Value = tx
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

    i = q
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

Akuini Thank you so much this works perfectly!!

 

[Akuini]

You're welcome & thanks for the feedback