J
junk.jason
Hi, below I have the code I use to make a new sheet using a list for
the names. Is there a way I can integrate code that will change the
color of the sheet tab randomly upon creation of the sheet?
Thanks!
Sub TabsFromList()
'David McRitchie based on previous code in sheets.htm
Application.ScreenUpdating = False
Dim cell As Range
Dim newName As String, xx As String
Err.Description = ""
On Error Resume Next
'--cells with numbers, including dates, will be ignored,
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
'Sheets.Add after:=Sheets(Sheets.Count)
Worksheets("Template").Copy after:=Worksheets(Worksheets.Count)
If Err.Description <> "" Then Exit Sub
Err.Description = ""
newName = cell.Text
ActiveSheet.Name = newName
If Err.Description <> "" Then
'--failed to rename, probably sheetname already exists...
xx = MsgBox("Failed to rename inserted worksheet " & _
vbLf & _
ActiveSheet.Name & " to " & newName & vbLf & _
Err.Number & " " & Err.Description, vbOKCancel, _
"Failed to Rename Worksheet, it will be deleted:")
'--eliminate already created sheet that failed to be
renamed...
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'--check for immediate cancellation...
If xx = vbCancel Then Exit Sub
Err.Description = ""
End If
Next cell
Application.ScreenUpdating = True
End Sub
the names. Is there a way I can integrate code that will change the
color of the sheet tab randomly upon creation of the sheet?
Thanks!
Sub TabsFromList()
'David McRitchie based on previous code in sheets.htm
Application.ScreenUpdating = False
Dim cell As Range
Dim newName As String, xx As String
Err.Description = ""
On Error Resume Next
'--cells with numbers, including dates, will be ignored,
For Each cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
'Sheets.Add after:=Sheets(Sheets.Count)
Worksheets("Template").Copy after:=Worksheets(Worksheets.Count)
If Err.Description <> "" Then Exit Sub
Err.Description = ""
newName = cell.Text
ActiveSheet.Name = newName
If Err.Description <> "" Then
'--failed to rename, probably sheetname already exists...
xx = MsgBox("Failed to rename inserted worksheet " & _
vbLf & _
ActiveSheet.Name & " to " & newName & vbLf & _
Err.Number & " " & Err.Description, vbOKCancel, _
"Failed to Rename Worksheet, it will be deleted:")
'--eliminate already created sheet that failed to be
renamed...
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
'--check for immediate cancellation...
If xx = vbCancel Then Exit Sub
Err.Description = ""
End If
Next cell
Application.ScreenUpdating = True
End Sub