worksheet tab name from list

  • Thread starter Thread starter Chris
  • Start date Start date
C

Chris

Hello

On my first worksheet there is a list of names. I would like these names to
come in the tab of the following worksheets because for every person in the
list there is a seperate worksheet with data and calculations.

i.e. worksheet with list of names = LIST. 2nd worksheet=John, 3rd
worksheet=Mary, according to the list on the LIST-worksheet.

Is this possible?

Thank you for any kind of help.
Chris
 
To just add new blank sheets with names based upon a list.

Sub Add_Sheets()
Dim rCell As Range
For Each rCell In Range("A1:A20")
With Worksheets.Add(After:=Worksheets(Worksheets.Count))
.Name = rCell.Value
End With
Next rCell
End Sub

If you wanted to copy a particular sheet multiple times you would need different
code.

Something like........................

Sub CreateNameSheets()
' by Dave Peterson
' List sheetnames required in col A in a sheet: List
' Sub will copy sheets based on the sheet named as: Template
' and name the sheets accordingly

Dim TemplateWks As Worksheet
Dim ListWks As Worksheet
Dim ListRng As Range
Dim myCell As Range

Set TemplateWks = Worksheets("Template")
Set ListWks = Worksheets("list")
With ListWks
Set ListRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In ListRng.Cells
TemplateWks.Copy After:=Worksheets(Worksheets.Count)
On Error Resume Next
ActiveSheet.Name = myCell.Value
If Err.Number <> 0 Then
MsgBox "Please fix: " & ActiveSheet.Name
Err.Clear
End If
On Error GoTo 0
Next myCell

End Sub


Gord Dibben MS Excel MVP
 
Dim cell As Range
For Each cell In Range("A2:A20")
With Worksheets

If cell.Value <> "" Then _
.Add(After:=Worksheets(.Count)).Name = cell.Value
End With
Next cell


--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
Thanks Gord,

it does the job. But would it be possible to have an automatic update of
name on the tab whenever I change a name in my list on the LIST worksheet?
Same question to Bob whose solution also works?

Chris
 
Thanks Bob,

it does the job. But would it be possible to have an automatic update of
name on the tab whenever I change a name in my list on the LIST worksheet?
Same question to Gord whose solution also works?

Chris
 
Hi Chris,

Once your added the sheets with names, then the following macro will rename
all the sheets anytime you make a change to the names you list in the range
A2:A20. This code goes in the code module for the sheet with the names
list. For example Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim I As Integer
Dim IntSec As Excel.Range

Set IntSec = Application.Intersect(Target, [A2:A20])
If Not IntSec Is Nothing Then
I = 1
For Each cell In Range("A2:A20")
If cell <> "" Then
Sheets(I + 1).Name = cell
I = I + 1
End If
Next cell
End If
End Sub

Cheers,
Shane Devenshire
Microsoft Excel MVP
Join http://setiathome.berkeley.edu/ and download a free screensaver to help
search for life beyond earth.
 
Hi Shane,

I tried the code you proposed, but I get an error on the 'Sheets(I + 1).Name
= cell'-part.
Do I have to alter anything in the code?

Chris


Shane Devenshire said:
Hi Chris,

Once your added the sheets with names, then the following macro will
rename all the sheets anytime you make a change to the names you list in
the range A2:A20. This code goes in the code module for the sheet with
the names list. For example Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim I As Integer
Dim IntSec As Excel.Range

Set IntSec = Application.Intersect(Target, [A2:A20])
If Not IntSec Is Nothing Then
I = 1
For Each cell In Range("A2:A20")
If cell <> "" Then
Sheets(I + 1).Name = cell
I = I + 1
End If
Next cell
End If
End Sub

Cheers,
Shane Devenshire
Microsoft Excel MVP
Join http://setiathome.berkeley.edu/ and download a free screensaver to
help search for life beyond earth.

Chris said:
Hello

On my first worksheet there is a list of names. I would like these names
to
come in the tab of the following worksheets because for every person in
the
list there is a seperate worksheet with data and calculations.

i.e. worksheet with list of names = LIST. 2nd worksheet=John, 3rd
worksheet=Mary, according to the list on the LIST-worksheet.

Is this possible?

Thank you for any kind of help.
Chris
Click to expand...
Click to expand...
 
Try this version

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
Dim NextSheet As Long
Dim sh As Worksheet

If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then

LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
NextSheet = 1
For i = 2 To LastRow

If Me.Cells(i, "A").Value <> "" Then

Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(Me.Cells(i, "A").Value)
On Error GoTo 0
If sh Is Nothing Then

Sheets(NextSheet).Name = Me.Cells(i, "A").Value
NextSheet = NextSheet + 1
End If
End If
Next i
End If
End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



Chris said:
Hi Shane,

I tried the code you proposed, but I get an error on the 'Sheets(I +
1).Name = cell'-part.
Do I have to alter anything in the code?

Chris


Shane Devenshire said:
Hi Chris,

Once your added the sheets with names, then the following macro will
rename all the sheets anytime you make a change to the names you list in
the range A2:A20. This code goes in the code module for the sheet with
the names list. For example Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim I As Integer
Dim IntSec As Excel.Range

Set IntSec = Application.Intersect(Target, [A2:A20])
If Not IntSec Is Nothing Then
I = 1
For Each cell In Range("A2:A20")
If cell <> "" Then
Sheets(I + 1).Name = cell
I = I + 1
End If
Next cell
End If
End Sub

Cheers,
Shane Devenshire
Microsoft Excel MVP
Join http://setiathome.berkeley.edu/ and download a free screensaver to
help search for life beyond earth.

Chris said:
Hello

On my first worksheet there is a list of names. I would like these names
to
come in the tab of the following worksheets because for every person in
the
list there is a seperate worksheet with data and calculations.

i.e. worksheet with list of names = LIST. 2nd worksheet=John, 3rd
worksheet=Mary, according to the list on the LIST-worksheet.

Is this possible?

Thank you for any kind of help.
Chris
Click to expand...
Click to expand...
Click to expand...
 
Okay, I decided it was too easy for you to screw up your worksheet if all
you implemented was what you requested, so I tried to develop a more
"complete" solution for you... and I almost have it. I **think** I have
covered all possibilities except one (more about that in a moment). The
following code should allow you to add, delete and modify (one at a time
only, and only by typing into the cell in the specified range) the names in
your list and have the proper action take place with the referenced
worksheets (for example, if you erase a name, and answer Yes to the question
that is asked, the name will be erased and the worksheet deleted). I believe
I have covered all of the possibilities (if not, let me know and I'll try
patch the code) with the exception of dragging/dropping text from a
**single** cell (I have multiple cells covered) into the range specified (in
the Const statement at the start of the code)... there seems to be no way to
detect drag-and-drop editing, or at least not that I have been able to find,
so I don't know how to stop a user from doing that. (If anyone knows of a
method, I would like to hear about it.) So, with that single exception, the
code below should (I hope) give you a fairly complete "editor" for the range
of cells containing your worksheet names. Give it a try and let me know.

'*************** START OF CODE ***************
Dim PreviousEntry As String
Dim MultipleSelection As Boolean
Const NameRange As String = "A2:A20"

Private Sub Worksheet_Activate()
If Not Intersect(ActiveCell, Range(NameRange)) Is Nothing Then
PreviousEntry = ActiveCell.Value
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim WS As Worksheet
Dim SheetName As String
Dim Answer As Long
If Not Intersect(Target, Range(NameRange)) Is Nothing Then
If MultipleSelection Then
MsgBox "You can only change worksheet names one-at-a-time!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Application.CutCopyMode <> False Then
MsgBox "You can only change worksheet names by typing!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Len(Trim(Target.Value)) = "" Or IsEmpty(Target.Value) Then
Answer = MsgBox("STOP!!! Deleting this name will DELETE the" & _
"associated worksheet ('" & PreviousEntry & _
"') meaning ALL data on it will be lost!" & _
vbNewLine & vbNewLine & _
"Do you still want to erase this name?", _
vbCritical Or vbYesNo Or vbDefaultButton2)
If Answer = vbYes Then
Application.DisplayAlerts = False
Worksheets(PreviousEntry).Delete
Application.DisplayAlerts = True
PreviousEntry = ""
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
ElseIf Not IsFileName(Target.Value) Then
MsgBox "That is not a valid worksheet name!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Len(Trim(PreviousEntry)) > 0 Then
For Each WS In Worksheets
If WS.Name = PreviousEntry Then
WS.Name = Target.Value
PreviousEntry = Target.Value
Exit For
End If
Next
ElseIf Len(PreviousEntry) = 0 Then
PreviousEntry = Target.Value
For X = Range(NameRange).Row To Target.Row - 1
If Len(Trim(Cells(X, Range(NameRange).Column).Value)) > 0 Then
SheetName = Cells(X, Range(NameRange).Column).Value
End If
Next
If Len(SheetName) > 0 Then
Worksheets.Add After:=Worksheets(SheetName)
Else
For X = Target.Row + 1 To Range(NameRange).Row +
Range(NameRange).Count
If Len(Trim(Cells(X, Range(NameRange).Column).Value)) > 0 Then
SheetName = Cells(X, Range(NameRange).Column).Value
Exit For
End If
Next
If Len(SheetName) > 0 Then
Worksheets.Add Before:=Worksheets(SheetName)
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
End If
End If
ActiveSheet.Name = Target.Value
Target.Parent.Select
End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MultipleSelection = (Target.Count > 1)
If Not MultipleSelection Then PreviousEntry = Target.Value
End Sub

Function IsFileName(StringIn As String) As Boolean
If Len(StringIn) > 255 Or StringIn Like "*[*?<>""/\|:']*" Or _
InStr(1, "*CON*AUX*COM1*COM2*COM3" & _
"*COM4*LPT1*LPT2*LPT3*PRN*NUL*", _
"*" & StringIn & "*", vbTextCompare) Then
IsFileName = False
Else
IsFileName = True
End If
End Function
'*************** END OF CODE ***************

Rick
 
Bob,

When I put the code in Sheet 1 this code makes the list worksheet change
name, but not the worksheet that should. When I put the code in the
ThisWorkbook-section nothing happens. I am probably doing something wrong,
but what?

Chris

Bob Phillips said:
Try this version

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim LastRow As Long
Dim NextSheet As Long
Dim sh As Worksheet

If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then

LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
NextSheet = 1
For i = 2 To LastRow

If Me.Cells(i, "A").Value <> "" Then

Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(Me.Cells(i, "A").Value)
On Error GoTo 0
If sh Is Nothing Then

Sheets(NextSheet).Name = Me.Cells(i, "A").Value
NextSheet = NextSheet + 1
End If
End If
Next i
End If
End Sub


--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my
addy)



Chris said:
Hi Shane,

I tried the code you proposed, but I get an error on the 'Sheets(I +
1).Name = cell'-part.
Do I have to alter anything in the code?

Chris


Shane Devenshire said:
Hi Chris,

Once your added the sheets with names, then the following macro will
rename all the sheets anytime you make a change to the names you list in
the range A2:A20. This code goes in the code module for the sheet with
the names list. For example Sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim I As Integer
Dim IntSec As Excel.Range

Set IntSec = Application.Intersect(Target, [A2:A20])
If Not IntSec Is Nothing Then
I = 1
For Each cell In Range("A2:A20")
If cell <> "" Then
Sheets(I + 1).Name = cell
I = I + 1
End If
Next cell
End If
End Sub

Cheers,
Shane Devenshire
Microsoft Excel MVP
Join http://setiathome.berkeley.edu/ and download a free screensaver to
help search for life beyond earth.

Hello

On my first worksheet there is a list of names. I would like these
names to
come in the tab of the following worksheets because for every person in
the
list there is a seperate worksheet with data and calculations.

i.e. worksheet with list of names = LIST. 2nd worksheet=John, 3rd
worksheet=Mary, according to the list on the LIST-worksheet.

Is this possible?

Thank you for any kind of help.
Chris
Click to expand...
Click to expand...
Click to expand...
 
Rick,

your code does indeed what I was looking for. In combination with the tab
generator-codes from both Bob and Gord, it is the complete package.

Thank you all very much.

Chris

Rick Rothstein (MVP - VB) said:
Okay, I decided it was too easy for you to screw up your worksheet if all
you implemented was what you requested, so I tried to develop a more
"complete" solution for you... and I almost have it. I **think** I have
covered all possibilities except one (more about that in a moment). The
following code should allow you to add, delete and modify (one at a time
only, and only by typing into the cell in the specified range) the names
in your list and have the proper action take place with the referenced
worksheets (for example, if you erase a name, and answer Yes to the
question that is asked, the name will be erased and the worksheet
deleted). I believe I have covered all of the possibilities (if not, let
me know and I'll try patch the code) with the exception of
dragging/dropping text from a **single** cell (I have multiple cells
covered) into the range specified (in the Const statement at the start of
the code)... there seems to be no way to detect drag-and-drop editing, or
at least not that I have been able to find, so I don't know how to stop a
user from doing that. (If anyone knows of a method, I would like to hear
about it.) So, with that single exception, the code below should (I hope)
give you a fairly complete "editor" for the range of cells containing your
worksheet names. Give it a try and let me know.

'*************** START OF CODE ***************
Dim PreviousEntry As String
Dim MultipleSelection As Boolean
Const NameRange As String = "A2:A20"

Private Sub Worksheet_Activate()
If Not Intersect(ActiveCell, Range(NameRange)) Is Nothing Then
PreviousEntry = ActiveCell.Value
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim WS As Worksheet
Dim SheetName As String
Dim Answer As Long
If Not Intersect(Target, Range(NameRange)) Is Nothing Then
If MultipleSelection Then
MsgBox "You can only change worksheet names one-at-a-time!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Application.CutCopyMode <> False Then
MsgBox "You can only change worksheet names by typing!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Len(Trim(Target.Value)) = "" Or IsEmpty(Target.Value) Then
Answer = MsgBox("STOP!!! Deleting this name will DELETE the" & _
"associated worksheet ('" & PreviousEntry & _
"') meaning ALL data on it will be lost!" & _
vbNewLine & vbNewLine & _
"Do you still want to erase this name?", _
vbCritical Or vbYesNo Or vbDefaultButton2)
If Answer = vbYes Then
Application.DisplayAlerts = False
Worksheets(PreviousEntry).Delete
Application.DisplayAlerts = True
PreviousEntry = ""
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
ElseIf Not IsFileName(Target.Value) Then
MsgBox "That is not a valid worksheet name!"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
ElseIf Len(Trim(PreviousEntry)) > 0 Then
For Each WS In Worksheets
If WS.Name = PreviousEntry Then
WS.Name = Target.Value
PreviousEntry = Target.Value
Exit For
End If
Next
ElseIf Len(PreviousEntry) = 0 Then
PreviousEntry = Target.Value
For X = Range(NameRange).Row To Target.Row - 1
If Len(Trim(Cells(X, Range(NameRange).Column).Value)) > 0 Then
SheetName = Cells(X, Range(NameRange).Column).Value
End If
Next
If Len(SheetName) > 0 Then
Worksheets.Add After:=Worksheets(SheetName)
Else
For X = Target.Row + 1 To Range(NameRange).Row +
Range(NameRange).Count
If Len(Trim(Cells(X, Range(NameRange).Column).Value)) > 0 Then
SheetName = Cells(X, Range(NameRange).Column).Value
Exit For
End If
Next
If Len(SheetName) > 0 Then
Worksheets.Add Before:=Worksheets(SheetName)
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
End If
End If
ActiveSheet.Name = Target.Value
Target.Parent.Select
End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MultipleSelection = (Target.Count > 1)
If Not MultipleSelection Then PreviousEntry = Target.Value
End Sub

Function IsFileName(StringIn As String) As Boolean
If Len(StringIn) > 255 Or StringIn Like "*[*?<>""/\|:']*" Or _
InStr(1, "*CON*AUX*COM1*COM2*COM3" & _
"*COM4*LPT1*LPT2*LPT3*PRN*NUL*", _
"*" & StringIn & "*", vbTextCompare) Then
IsFileName = False
Else
IsFileName = True
End If
End Function
'*************** END OF CODE ***************

Rick


Chris said:
Hello

On my first worksheet there is a list of names. I would like these names
to
come in the tab of the following worksheets because for every person in
the
list there is a seperate worksheet with data and calculations.

i.e. worksheet with list of names = LIST. 2nd worksheet=John, 3rd
worksheet=Mary, according to the list on the LIST-worksheet.

Is this possible?

Thank you for any kind of help.
Chris
Click to expand...
Click to expand...
 
Back
Top