![]() |
Generate sheetnames and skip cells?
Hi,
I am getting close to completing a project, but running into a few snags. The first one is that part of the code is not executing correctly. Here is the full code, below. WeeklyTallyNames is designed to insert the names of the worksheets into cells D3,G3,J3,M3,etc. I need to be able to exclude a few sheets, namely "Team Listing", "Weekly Tally" and "Template" which are not generated by "TabsFromList". GenerateAgents is run from a button on Team Listing. Another issue is that not all of the sheet names are being inserted. The list is in the format, (Lastname, First) I am aware that TabsFromList will not work with dates, although a fix for that would be great! Any ideas? 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 Sub WeeklyTallyNames() Sheets("Weekly Tally").Activate k = 4 For Each w In Sheets AgentName = w.Name If nm < "Template" Then Cells(3, k).Value = AgentName k = k + 1 End If Next End Sub Sub GenerateAgents() Call TabsFromList Call WeeklyTallyNames End Sub Thanks, - Alden |
Generate sheetnames and skip cells?
I added a fix for eliminating all 3 worksheeets by adding an "AND" statement.
I also added a statement CSTR to convert non text cells to the code. Add 2nd msgbox is sheet cannot be added. 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 Selection 'Sheets.Add after:=Sheets(Sheets.Count) Worksheets("Template"). _ Copy after:=Worksheets(Worksheets.Count) If Err.Description < "" Then MsgBox ("Can't add worksheet " & _ CStr(cell)) Err.Description = "" Else newName = CStr(cell) 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 End If Next cell Application.ScreenUpdating = True End Sub Sub WeeklyTallyNames() Sheets("Weekly Tally").Activate k = 4 For Each w In Sheets AgentName = w.Name If (nm < "Template") And _ (nm < "Team Listing") And _ (nm < "Weekly Tally") Then Cells(3, k).Value = AgentName k = k + 1 End If Next End Sub Sub GenerateAgents() Call TabsFromList Call WeeklyTallyNames End Sub " wrote: Hi, I am getting close to completing a project, but running into a few snags. The first one is that part of the code is not executing correctly. Here is the full code, below. WeeklyTallyNames is designed to insert the names of the worksheets into cells D3,G3,J3,M3,etc. I need to be able to exclude a few sheets, namely "Team Listing", "Weekly Tally" and "Template" which are not generated by "TabsFromList". GenerateAgents is run from a button on Team Listing. Another issue is that not all of the sheet names are being inserted. The list is in the format, (Lastname, First) I am aware that TabsFromList will not work with dates, although a fix for that would be great! Any ideas? 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 Sub WeeklyTallyNames() Sheets("Weekly Tally").Activate k = 4 For Each w In Sheets AgentName = w.Name If nm < "Template" Then Cells(3, k).Value = AgentName k = k + 1 End If Next End Sub Sub GenerateAgents() Call TabsFromList Call WeeklyTallyNames End Sub Thanks, - Alden |
All times are GMT +1. The time now is 12:34 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com