I don't think this macro is going to work for this problem. There are 84
service groups on this sheet and an undertermined number of service groups on
other sheets. I'm getting a runtime subscript out of range right above the
line that fills the array but all I have to do is add the 24 rows to each
service group. I was going to try this on only half of the service groups
but I can't get it to run. If I can get this to run it would have to figure
out how many service groups are in each sheet in column H.

thanks,

Dim iCtr As Long
Dim wks As Worksheet
Dim FoundCell As Range

myTypes = Array("SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7", "SG8",
"SG9", "SG10", "SG11", "SG12", "SG13", "SG14", "SG15", "SG16", "SG17",
"SG18", "SG19", "SG20", "SG21", "SG22", "SG23", "SG24""SG25", "SG26", "SG27",
"SG28", "SG29", "SG30", "SG31", "SG32", "SG33", "SG34", "SG35", "SG36",
"SG37", "SG39", "SG40")

Set wks = Worksheets("sheet1")

With wks.Range("H1").EntireColumn
For iCtr = LBound(myTypes) To UBound(myTypes)
Set FoundCell = .Cells.Find(what:=myTypes(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTypes(iCtr) & " wasn't found!"
Else
FoundCell.Offset(1, 0).Resize(24).EntireRow.Insert
End If
Next iCtr
End With

End Sub

My first try on this is:

---------------------

Private Sub PutARowIn()
Dim rng As Range
Dim cell As Range
Set rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
rng.Select
For Each cell In rng
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Next
End Sub

P.S. the best way to find the number of service groups is to find all the
blank sub total rows. The next service group starts after the blank.

"Janis" wrote:

I don't think this macro is going to work for this problem. There are 84
service groups on this sheet and an undertermined number of service groups on
other sheets. I'm getting a runtime subscript out of range right above the
line that fills the array but all I have to do is add the 24 rows to each
service group. I was going to try this on only half of the service groups
but I can't get it to run. If I can get this to run it would have to figure
out how many service groups are in each sheet in column H.

thanks,

Dim iCtr As Long
Dim wks As Worksheet
Dim FoundCell As Range

myTypes = Array("SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7", "SG8",
"SG9", "SG10", "SG11", "SG12", "SG13", "SG14", "SG15", "SG16", "SG17",
"SG18", "SG19", "SG20", "SG21", "SG22", "SG23", "SG24""SG25", "SG26", "SG27",
"SG28", "SG29", "SG30", "SG31", "SG32", "SG33", "SG34", "SG35", "SG36",
"SG37", "SG39", "SG40")

Set wks = Worksheets("sheet1")

With wks.Range("H1").EntireColumn
For iCtr = LBound(myTypes) To UBound(myTypes)
Set FoundCell = .Cells.Find(what:=myTypes(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTypes(iCtr) & " wasn't found!"
Else
FoundCell.Offset(1, 0).Resize(24).EntireRow.Insert
End If
Next iCtr
End With

End Sub

My first try on this is:

---------------------

Private Sub PutARowIn()
Dim rng As Range
Dim cell As Range
Set rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
rng.Select
For Each cell In rng
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Next
End Sub

"Janis" wrote:

P.S. the best way to find the number of service groups is to find all the
blank sub total rows. The next service group starts after the blank.

"Janis" wrote:

I don't think this macro is going to work for this problem. There are 84
service groups on this sheet and an undertermined number of service groups on
other sheets. I'm getting a runtime subscript out of range right above the
line that fills the array but all I have to do is add the 24 rows to each
service group. I was going to try this on only half of the service groups
but I can't get it to run. If I can get this to run it would have to figure
out how many service groups are in each sheet in column H.

thanks,

Dim iCtr As Long
Dim wks As Worksheet
Dim FoundCell As Range

myTypes = Array("SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7", "SG8",
"SG9", "SG10", "SG11", "SG12", "SG13", "SG14", "SG15", "SG16", "SG17",
"SG18", "SG19", "SG20", "SG21", "SG22", "SG23", "SG24""SG25", "SG26", "SG27",
"SG28", "SG29", "SG30", "SG31", "SG32", "SG33", "SG34", "SG35", "SG36",
"SG37", "SG39", "SG40")

Set wks = Worksheets("sheet1")

With wks.Range("H1").EntireColumn
For iCtr = LBound(myTypes) To UBound(myTypes)
Set FoundCell = .Cells.Find(what:=myTypes(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTypes(iCtr) & " wasn't found!"
Else
FoundCell.Offset(1, 0).Resize(24).EntireRow.Insert
End If
Next iCtr
End With

End Sub

My first try on this is:

---------------------

Private Sub PutARowIn()
Dim rng As Range
Dim cell As Range
Set rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
rng.Select
For Each cell In rng
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Next
End Sub

I fixed the out of range error by adding the sheet name. I still need to
figure out how to automate adding the number of service groups to the array
:-)
thanks,

"Janis" wrote:

I don't think this macro is going to work for this problem. There are 84
service groups on this sheet and an undertermined number of service groups on
other sheets. I'm getting a runtime subscript out of range right above the
line that fills the array but all I have to do is add the 24 rows to each
service group. I was going to try this on only half of the service groups
but I can't get it to run. If I can get this to run it would have to figure
out how many service groups are in each sheet in column H.

thanks,

Dim iCtr As Long
Dim wks As Worksheet
Dim FoundCell As Range

myTypes = Array("SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7", "SG8",
"SG9", "SG10", "SG11", "SG12", "SG13", "SG14", "SG15", "SG16", "SG17",
"SG18", "SG19", "SG20", "SG21", "SG22", "SG23", "SG24""SG25", "SG26", "SG27",
"SG28", "SG29", "SG30", "SG31", "SG32", "SG33", "SG34", "SG35", "SG36",
"SG37", "SG39", "SG40")

Set wks = Worksheets("sheet1")

With wks.Range("H1").EntireColumn
For iCtr = LBound(myTypes) To UBound(myTypes)
Set FoundCell = .Cells.Find(what:=myTypes(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTypes(iCtr) & " wasn't found!"
Else
FoundCell.Offset(1, 0).Resize(24).EntireRow.Insert
End If
Next iCtr
End With

End Sub

My first try on this is:

---------------------

Private Sub PutARowIn()
Dim rng As Range
Dim cell As Range
Set rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
rng.Select
For Each cell In rng
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Next
End Sub

I will repost this one to clarify the question.

"Janis" wrote:

I don't think this macro is going to work for this problem. There are 84
service groups on this sheet and an undertermined number of service groups on
other sheets. I'm getting a runtime subscript out of range right above the
line that fills the array but all I have to do is add the 24 rows to each
service group. I was going to try this on only half of the service groups
but I can't get it to run. If I can get this to run it would have to figure
out how many service groups are in each sheet in column H.

thanks,

Dim iCtr As Long
Dim wks As Worksheet
Dim FoundCell As Range

myTypes = Array("SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7", "SG8",
"SG9", "SG10", "SG11", "SG12", "SG13", "SG14", "SG15", "SG16", "SG17",
"SG18", "SG19", "SG20", "SG21", "SG22", "SG23", "SG24""SG25", "SG26", "SG27",
"SG28", "SG29", "SG30", "SG31", "SG32", "SG33", "SG34", "SG35", "SG36",
"SG37", "SG39", "SG40")

Set wks = Worksheets("sheet1")

With wks.Range("H1").EntireColumn
For iCtr = LBound(myTypes) To UBound(myTypes)
Set FoundCell = .Cells.Find(what:=myTypes(iCtr), _
after:=.Cells(1), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
Searchdirection:=xlPrevious, _
MatchCase:=False)
If FoundCell Is Nothing Then
MsgBox myTypes(iCtr) & " wasn't found!"
Else
FoundCell.Offset(1, 0).Resize(24).EntireRow.Insert
End If
Next iCtr
End With

End Sub

My first try on this is:

---------------------

Private Sub PutARowIn()
Dim rng As Range
Dim cell As Range
Set rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
rng.Select
For Each cell In rng
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
Next
End Sub