J
Janis
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
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