Generate sheet names from list, assign data to summary sheet.

[Jason.Alden.Benoit]

Hi,

I have a macro that will generate sheets from a template and name
them from selected names in cells. I then would like from the new
sheets to be able to automatically have the data systematically pulled
over to a summary sheet. Basically I have a "tally" template that will
generate with a person's name.(I also have the sheet's/person's name
generate in a cell on the form.) I then have the data tally up in a
summary on that sheet. On a single summary sheet I want to be able to
be able to look at all summarized data from all other sheets, with a
heading of the sheet and therefore person's name above the data.

I haven't come up with a way to edit the heading's on the summary
sheet with the sheets in the work books or the person's name. If I
could do that I can handle the rest. There may be a few ways to do
this, I just need one. : ) I had thought about when generating the
template sheets "grabbing" the name of the sheet as it is generated
and sequentially editing the cells for the headers on the summary
sheet, but not sure if this is possible. It would be going horizontal
and skipping three cells. The template generation code is below,
modified slightly by me:

////

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

///

.. I am not very experienced with macros but I can hack them VERY
little; mainly change values, not sure what I am doing as far as
writing them. Thanks for any ideas, and if you have anything I could
help clarify please let me know! Thanks!

- Alden

 

[Guest]

I am not certain that I understand you exact needs. Lets say I have just
created a set of sheets within a workbook and I want to make column headers
in a sheet called "summary".

I want to get the headers from the sheet names (person names), skipping some
columns in the process>

Sub jason()
Sheets("summary").Activate
k = 1
For Each w In Sheets
nm = w.Name
If nm <> "summary" Then
Cells(1, k).Value = nm
k = k + 4
End If
Next
End Sub

Try this out on a scrap workbook first.

 

[Jason.Alden.Benoit]

My reply seems to have disappeared.. weird.

Thank you for your help. I think this will work, with a few
adjustments. How can I combine this macro with the one I mentioned
earlier? Also, how can I designate the sequence of cells to edit start
with D4?


Thanks!

-Alden

 

[Guest]

Sub Main
Call TabsFromList
Call jason
End Sub

will call our two programs sequentially. As currently written, jason will
put headers in A1, E1, I1, M1, etc.

This version will start in D4 rather than A1:

Sub jason()
Sheets("summary").Activate
k = 4
For Each w In Sheets
nm = w.Name
If nm <> "summary" Then
Cells(4, k).Value = nm
k = k + 4
End If
Next
End Sub

Only two lines changed. The headers will now go in:
D4, H4, L4, .....

 

[Jason.Alden.Benoit]

Thanks, that did the trick! Below is my current coding, adjusted for
me:

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


Can I exclude certain sheets from having their names copied into the
Weekly Tally sheet?

The next thing I am working on and haven't figured out how to go
about it yet is I need to take the range V6:X66 from each named sheet
and copy that data below the corresponding name that was entered into
the cells from the "jason" macro. So the first set of data will go to
D6:F66, the next set G66:I66, etc looping until the sheet names are
all covered. If I could used a named range so that I can more easily
port the coding to another sheet that would be best. Currently B4 is
the cell that I have slated to contain the sheet names in, which is
already setup to do automatically. Any ideas on how to go about that?

Thanks again!