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

maybe you can integrate this into your code

Sub tbcolor()
Dim Cindex As Long, i As Long

For i = 1 To Worksheets.Count
Cindex = Int((56 - 2 + 1) * Rnd + 2)
Worksheets(i).Tab.ColorIndex = Cindex
Next i
End Sub

--


Gary


wrote in message
ps.com...
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

if it's always the last sheet:

Sub tbcolor()
Dim Cindex As Long, i As Long
i = Worksheets.Count
Cindex = Int((56 - 2 + 1) * Rnd + 2)
Worksheets(i).Tab.ColorIndex = Cindex

End Sub

--


Gary


wrote in message
oups.com...
I run the Macro and it randomly colors all t he tabs.Now I just have to
figure out how to make it work on only the new tabs, while executing at
the same time as the first macro. To bad I barely know what I am doing
and can't read the code all that well. But thanks! I am sure soon I
will get it sorted completely out.


Gary Keramidas wrote:
maybe you can integrate this into your code

Sub tbcolor()
Dim Cindex As Long, i As Long

For i = 1 To Worksheets.Count
Cindex = Int((56 - 2 + 1) * Rnd + 2)
Worksheets(i).Tab.ColorIndex = Cindex
Next i
End Sub

--


Gary


wrote in message
ps.com...
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