Random Tab Color on sheet creation.
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 |
Random Tab Color on sheet creation.
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 |
Random Tab Color on sheet creation.
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 |
All times are GMT +1. The time now is 10:04 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com