Generate sheetnames and skip cells?

[Jason.Alden.Benoit]

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

 

[Guest]

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