S
styoda
Hi,
I'm incredibly rusty with VB for macro's, and I'm a little lost here.
With this code, which works, it looks for the names "ServerA", "ServerB" etc
and then formats the cells. But I need to insert 2 rows just above
"ServerNM", but when I do this it gets stuck in a loop as the number of rows
have changed and never gets onto the next ServerNM.
The only way I think I can do this is to start from the bottom of the list,
"LastCell_F".
Is it possible to scan from the bottom of the list or anyone have any ideas
as to how I can insert 2 rows just above every "ServerNM"?
Range("F1000").End(xlUp).Offset(0, 0).Select
LastCell_F = ActiveCell.Row
Dim ServerA As Long
Dim ServerB As Long
Dim ServerC As Long
Dim ServerD As Long
Dim ServerE As Long
For Each ServerNM In Worksheets("Quote").Range("A10:A" & LastCell_F)
ServerA = InStr(1, (ServerNM.Value), "ServerA")
ServerB = InStr(1, (ServerNM.Value), "ServerB")
ServerC = InStr(1, (ServerNM.Value), "ServerC")
ServerD = InStr(1, (ServerNM.Value), "ServerD")
ServerE = InStr(1, (ServerNM.Value), "ServerE")
If ServerA > 0 Or ServerB > 0 Or ServerC > 0 Or ServerD > 0 Or ServerE >
0 Then
ServerNM.Select
Selection.Font.Bold = True
ServerNM.Offset(0, 2).Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ServerNM.Offset(1, 2).Select
Selection.Font.Italic = True
Selection.Font.Bold = True
ServerNM.Offset(1, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
ServerNM.Offset(0, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
ServerNM.Offset(-1, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
End If
Next ServerNM
Range("A1").Select
End Sub
Hope someone can help,
Thanks
S
I'm incredibly rusty with VB for macro's, and I'm a little lost here.
With this code, which works, it looks for the names "ServerA", "ServerB" etc
and then formats the cells. But I need to insert 2 rows just above
"ServerNM", but when I do this it gets stuck in a loop as the number of rows
have changed and never gets onto the next ServerNM.
The only way I think I can do this is to start from the bottom of the list,
"LastCell_F".
Is it possible to scan from the bottom of the list or anyone have any ideas
as to how I can insert 2 rows just above every "ServerNM"?
Range("F1000").End(xlUp).Offset(0, 0).Select
LastCell_F = ActiveCell.Row
Dim ServerA As Long
Dim ServerB As Long
Dim ServerC As Long
Dim ServerD As Long
Dim ServerE As Long
For Each ServerNM In Worksheets("Quote").Range("A10:A" & LastCell_F)
ServerA = InStr(1, (ServerNM.Value), "ServerA")
ServerB = InStr(1, (ServerNM.Value), "ServerB")
ServerC = InStr(1, (ServerNM.Value), "ServerC")
ServerD = InStr(1, (ServerNM.Value), "ServerD")
ServerE = InStr(1, (ServerNM.Value), "ServerE")
If ServerA > 0 Or ServerB > 0 Or ServerC > 0 Or ServerD > 0 Or ServerE >
0 Then
ServerNM.Select
Selection.Font.Bold = True
ServerNM.Offset(0, 2).Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
ServerNM.Offset(1, 2).Select
Selection.Font.Italic = True
Selection.Font.Bold = True
ServerNM.Offset(1, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
ServerNM.Offset(0, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
ServerNM.Offset(-1, 7).Select
With Selection.Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
End If
Next ServerNM
Range("A1").Select
End Sub
Hope someone can help,
Thanks
S