Macro to insert Rows

[marc747]

Hi I have data in excel file that in Column "A" has ID numbers and
column "HC" has numbers for different categories that Group "A" ID
Numbers, these categories need to be in groups of 16 Rows if more that
16 Rows in each category then it should be in group of 32 rows or 48
and so on, the important thing is that I need a Macro to insert rows
in between this categories to make the rows equal to 16 or 32 or 48
and so on.

example I have the category numbered as "101" 2nd "104" 3rd 107.

1st group "101" has 12 ID numbers in Column "A" - need to insert 4
rows right after category 101 ends. Rows will = 16
2nd group "104" has 19 ID numbers in Column "A" - need to insert 13
rows right after category 104 ends. Rows will = 32
3rd group "107" has 38 ID numbers in Column "A" - need to insert 10
rows right after category 107 ends. Rows will = 48

I hope I was able to explain clearly, if any questions let me know....
I would appreciate for any help

 

[macropod]

Hi marc,

What is the purpose?

Inserting rows is easy enough, but there may be a better way to achieve what you want. If, for example, you only want a single
category to appear on each page of a printout, inserting hard pagebreaks should suffice. If it's because of the way a particular
formula works, then a different formula might be more appropriate.

 

[Don Guillett]

Try this idea that makes a unique list of col a for col F and then uses that
to count and then insert rows.

Sub makeuniquelistandcount1()
Application.ScreenUpdating = False

mc = "a"
lr = Cells(rows.Count, mc).End(xlUp).Row
With Range("A1:A" & lr)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Copy Range("F1")
Application.CutCopyMode = False
ActiveSheet.ShowAllData
End With

flr = Cells(rows.Count, "f").End(xlUp).Row
For i = flr To 2 Step -1
Cells(i, "g") = Application.CountIf(Range("a2:a" & lr), Cells(i, "f"))
mr = Columns("A").Find(Cells(i, "f"), After:=Cells(lr, "a"),
LookIn:=xlValues, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'MsgBox mr
Set mycell = Cells(i, "g")
'MsgBox mycell

Select Case mycell
Case 32 To 48: x = 48 - mycell
Case 16 To 32: x = 36 - mycell
Case 1 To 16: x = 16 - mycell
Case Else
End Select
Range(Cells(mr, "a"), Cells(mr + x - 1, "a")).EntireRow.Insert
'MsgBox x
Next i

Application.ScreenUpdating = True
End Sub

 

[marc747]

Thanks Don, I tried the code but if gives an error @ "mr =
Columns("HB").Find(Cells(i, "HC"), After:=Cells(lr, "a"),"
also in Column "HC" I have unique numbers that separate the groups, is
it necessary to insert additional Columns (f)

Thanks,

 

[Don Guillett]

If desired, send your file along with snippets of these posts to my address
below.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Thanks Don, I tried the code but if gives an error @ "mr =
Columns("HB").Find(Cells(i, "HC"), After:=Cells(lr, "a"),"
also in Column "HC" I have unique numbers that separate the groups, is
it necessary to insert additional Columns (f)

Thanks,