Update sheetname from cell, automatically

  • Thread starter Thread starter betuttle52
  • Start date Start date
B

betuttle52

Can this be modified so a cell that is changed on another worksheet be
the trigger instead of the cell of the current worksheet. for example
cell "A3" on a worksheet named "Setup"? Thanks to anyone that can
help.

Sheetname from cell, automatically

If you want to have your sheet name change when a cell value is
changed, you can use this Worksheet_Change() event macro. Put it in
your worksheet code module. Note that it has minimal error checking.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A1"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Me.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Me.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub



Change the value of sNAMECELL to your desired cell.

This page last updated Sunday, 28 November 2004
 
Can this be modified so a cell that is changed on another worksheet be
the trigger instead of the cell of the current worksheet. for example
cell "A3" on a worksheet named "Setup"? Thanks to anyone that can
help.

Sheetname from cell, automatically

If you want to have your sheet name change when a cell value is
changed, you can use this Worksheet_Change() event macro. Put it in
your worksheet code module. Note that it has minimal error checking.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A1"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Me.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Me.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub

Change the value of sNAMECELL to your desired cell.

This page last updated Sunday, 28 November 2004
Click to expand...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

If StrComp(Sh.Name, "Setup") <> 0 Then Exit Sub
With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
ActiveSheet.Name = sSheetName
On Error GoTo 0
If Not sSheetName = ActiveSheet.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub
 
The worksheet_Change event only looks for changes to the worksheet that owns the
code.

But you can use the worksheet_change event under the Setup worksheet to change
the name of any worksheet in your workbook.

If you want to try, then remove the worksheet_change code (if you added it to
the other sheet). Then add this behind the Setup sheet (rightclick on the Setup
tab and choose view code and then paste this into the code window):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet1.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub


Notice that the Me keyword has been replaced with Sheet1. Me represents the
object owning the code--in your old code (Bob Phillips' code??), that's the
worksheet being changed.

In this suggested code, I used Sheet1.

That's the name you see in the project explorer when you select your project
Hit ctrl-r to see the project explorer
Expand the project to see the "microsoft excel objects"

You'll see:
Sheet1(somesheetnamehere)
The name in ()'s is the name the user sees on the worksheet tab in excel.
The name in front of that (Sheet1 in this case) is the codename. It's much more
difficult for the users to change this name and it's usually much safer to use
the codename in your VBA code.
 
I don't think that this will work.

Unless the workbook's window has some sheets grouped, the activesheet will be
Setup and the code will be renaming that Setup sheet.

ps. It's probably a good idea to qualify those range variables.

If Not Intersect(.Cells, sh.Range(sNAMECELL)) Is Nothing Then
sSheetName = sh.Range(sNAMECELL).Value

It could stop problems when sheets are grouped.
 
The worksheet_Change event only looks for changes to the worksheet that owns the
code.

But you can use the worksheet_change event under the Setup worksheet to change
the name of any worksheet in your workbook.

If you want to try, then remove the worksheet_change code (if you added it to
the other sheet). Then add this behind the Setup sheet (rightclick on the Setup
tab and choose view code and then paste this into the code window):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet1.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub

Notice that the Me keyword has been replaced with Sheet1. Me represents the
object owning the code--in your old code (Bob Phillips' code??), that's the
worksheet being changed.

In this suggested code, I used Sheet1.

That's the name you see in the project explorer when you select your project
Hit ctrl-r to see the project explorer
Expand the project to see the "microsoft excel objects"

You'll see:
Sheet1(somesheetnamehere)
The name in ()'s is the name the user sees on the worksheet tab in excel.
The name in front of that (Sheet1 in this case) is the codename. It's much more
difficult for the users to change this name and it's usually much safer to use
the codename in your VBA code.
Click to expand...

Dave thanks this work great except for a couple of things. The first
time I ran the code it worked perfect. Now when I make a change in A3
I get a message Invalid worksheet name in cell A3 but the name is
changed correctly.

second I tried copy the code to a second line and changed A3 to A4 and
changed sheet2.name to sheet3.name. When I change cell A4 I get a
compilation error Ambiguous name detected: Worksheet_Change. What am I
doing wrong. Here is a copy of the code

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target

If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet2.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A4"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target

If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet3.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub
 
The worksheet_Change event only looks for changes to the worksheet that owns the
code.

But you can use the worksheet_change event under the Setup worksheet to change
the name of any worksheet in your workbook.

If you want to try, then remove the worksheet_change code (if you added it to
the other sheet). Then add this behind the Setup sheet (rightclick on the Setup
tab and choose view code and then paste this into the code window):

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target
If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet1.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub

Notice that the Me keyword has been replaced with Sheet1. Me represents the
object owning the code--in your old code (Bob Phillips' code??), that's the
worksheet being changed.

In this suggested code, I used Sheet1.

That's the name you see in the project explorer when you select your project
Hit ctrl-r to see the project explorer
Expand the project to see the "microsoft excel objects"

You'll see:
Sheet1(somesheetnamehere)
The name in ()'s is the name the user sees on the worksheet tab in excel.
The name in front of that (Sheet1 in this case) is the codename. It's much more
difficult for the users to change this name and it's usually much safer to use
the codename in your VBA code.
Click to expand...

Dave thanks this work great except for a couple of things. The first
time I ran the code it worked perfect. Now when I make a change in A3
I get a message Invalid worksheet name in cell A3 but the name is
changed correctly.

second I tried copy the code to a second line and changed A3 to A4 and
changed sheet2.name to sheet3.name. When I change cell A4 I get a
compilation error Ambiguous name detected: Worksheet_Change. What am I
doing wrong. Here is a copy of the code

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A3"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target

If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet2.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sNAMECELL As String = "A4"
Const sERROR As String = "Invalid worksheet name in cell "
Dim sSheetName As String

With Target

If Not Intersect(.Cells, Range(sNAMECELL)) Is Nothing Then
sSheetName = Range(sNAMECELL).Value
If Not sSheetName = "" Then
On Error Resume Next
Sheet3.Name = sSheetName
On Error GoTo 0
If Not sSheetName = Sheet1.Name Then _
MsgBox sERROR & sNAMECELL
End If
End If
End With
End Sub
 
For the first problem, you'll have to share what you typed into A3. My bet is
that you may think that it's valid, but excel KNOWS that it's not. (Is it a
date or time? They can cause problems.)

Second, you only get one of those events. You have to combine the code into one
procedure:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Const sNAMECELL1 As String = "A3"
Const sNAMECELL2 As String = "A4"
Const sERROR As String = "Invalid worksheet name in cell "

Dim sSheetName As String
Dim mySheet As Object

With Target

'only one cell at a time
If .Cells.Count > 1 Then Exit Sub

If Not (Intersect(.Cells, Me.Range(sNAMECELL1)) Is Nothing) Then
'in A3
Set mySheet = Sheet2
ElseIf Not (Intersect(.Cells, Me.Range(sNAMECELL2)) Is Nothing) Then
'in A4
Set mySheet = Sheet3
Else
'not in either cell
Exit Sub
End If

sSheetName = .Value 'or .text if you have it formatted nicely

If Not sSheetName = "" Then
On Error Resume Next
mySheet.Name = sSheetName
If Err.Number <> 0 Then
MsgBox sERROR & .Address(0, 0)
End If
On Error GoTo 0
End If
End With
End Sub

If you are using a date or time, but you have the cell formatted nicely (no
slashes, no backslashes, no colons, no anything bad), then you could use .text
instead of .value in the rename statement.

ps.

You may have noticed that most regulars are top posters. (Yes, it's different
than most newsgroups.) Personally, I find it easier to follow the thread when
people top post.

You may want to conform to what most of the regulars do.
 
This is really great. Thanks for your help and thanks for the advice
on top posting except I can't figure out how to top post. I was using
Firefox and going on goggle newsgroups for the posting. I can't find
any settings anywhere for top posting unless putting this at the top
instead of the bottom is what you mean.

I figured out what the error was I didn't make all of the changes
correctly. I am not using dates as tab names only text. I have created
an excel workbook for keeping track of volley stats. I have tabs for
16 tournaments and 15 players. Each tournament name and player name
and number are entered on the setup page. To make it easier to go to
the correct tournament or player tab I have created hyperlinks. I also
wanted to automatically update the sheet name so a user could quickly
go to a tournament or player by clicking on a tab that had the name
of the tournament or player. I know that I can create 21 constants and
1 If Not and 20 ElseIf Not sections but I'm sure that their must be a
better way. I just stated learning visual basic last week. I have just
learned since my first post that you can use a constant just once, And
the difference in sheets vs. sheet. You have been really helpful.
 
First, thank you for top-posting. That's exactly what I meant.

I'm not quite sure I understand the question, though.

If you want a quick way to go to different worksheets, you could use a toolbar
that allows you to select the one you want.

Here's a macro from Debra Dalgleish's site:
http://contextures.com/xlToolbar01.html

As for renaming sheets, I'd drop the worksheet_change event and use a dedicated
macro.

You could base it on the sheet number (reading the tabs from the left to the
right) or the codename. I'm not sure of the layout of your workbook, though.
 
Sorry to be so unclear in my last post. This is what I was talking
about. It works absolute perfectly its just alot of code

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Const sTOURCELL1 As String = "A3"
Const sTOURCELL2 As String = "A4"
Const sTOURCELL3 As String = "A5"
Const sTOURCELL4 As String = "A6"
Const sTOURCELL5 As String = "A7"
Const sTOURCELL6 As String = "A8"
Const sTOURCELL7 As String = "A9"
Const sTOURCELL8 As String = "A10"
Const sTOURCELL9 As String = "A11"
Const sTOURCELL10 As String = "A12"
Const sTOURCELL11 As String = "A13"
Const sTOURCELL12 As String = "A14"
Const sTOURCELL13 As String = "A15"
Const sTOURCELL14 As String = "A16"
Const sTOURCELL15 As String = "A17"
Const sTOURCELL16 As String = "A18"
Const sPLAYERNAMECELL1 As String = "A22"
Const sPLAYERNAMECELL2 As String = "A23"
Const sPLAYERNAMECELL3 As String = "A24"
Const sPLAYERNAMECELL4 As String = "A25"
Const sPLAYERNAMECELL5 As String = "A26"
Const sPLAYERNAMECELL6 As String = "A27"
Const sPLAYERNAMECELL7 As String = "A28"
Const sPLAYERNAMECELL8 As String = "A29"
Const sPLAYERNAMECELL9 As String = "A30"
Const sPLAYERNAMECELL10 As String = "A31"
Const sPLAYERNAMECELL11 As String = "A32"
Const sPLAYERNAMECELL12 As String = "A33"
Const sPLAYERNAMECELL13 As String = "A34"
Const sPLAYERNAMECELL14 As String = "A35"
Const sPLAYERNAMECELL15 As String = "A36"
Const sPLAYERNUMBERCELL1 As String = "B22"
Const sPLAYERNUMBERCELL2 As String = "B23"
Const sPLAYERNUMBERCELL3 As String = "B24"
Const sPLAYERNUMBERCELL4 As String = "B25"
Const sPLAYERNUMBERCELL5 As String = "B26"
Const sPLAYERNUMBERCELL6 As String = "B27"
Const sPLAYERNUMBERCELL7 As String = "B28"
Const sPLAYERNUMBERCELL8 As String = "B29"
Const sPLAYERNUMBERCELL9 As String = "B30"
Const sPLAYERNUMBERCELL10 As String = "B31"
Const sPLAYERNUMBERCELL11 As String = "B32"
Const sPLAYERNUMBERCELL12 As String = "B33"
Const sPLAYERNUMBERCELL13 As String = "B34"
Const sPLAYERNUMBERCELL14 As String = "B35"
Const sPLAYERNUMBERCELL15 As String = "B36"

Const sERROR As String = "Invalid worksheet name in cell "

Dim sSheetName As String
Dim mySheet As Object

With Target

'only one cell at a time
If .Cells.Count > 1 Then Exit Sub

If Not (Intersect(.Cells, Me.Range(sTOURCELL1)) Is Nothing)
Then
'in A3
Set mySheet = Sheet2
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL2)) Is
Nothing) Then
'in A4
Set mySheet = Sheet3
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL3)) Is
Nothing) Then
'in A5
Set mySheet = Sheet4
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL4)) Is
Nothing) Then
'in A6
Set mySheet = Sheet5
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL5)) Is
Nothing) Then
'in A7
Set mySheet = Sheet6
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL6)) Is
Nothing) Then
'in A8
Set mySheet = Sheet7
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL7)) Is
Nothing) Then
'in A9
Set mySheet = Sheet8
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL8)) Is
Nothing) Then
'in A10
Set mySheet = Sheet9
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL9)) Is
Nothing) Then
'in A11
Set mySheet = Sheet10
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL10)) Is
Nothing) Then
'in A12
Set mySheet = Sheet11
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL11)) Is
Nothing) Then
'in A13
Set mySheet = Sheet12
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL12)) Is
Nothing) Then
'in A14
Set mySheet = Sheet13
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL13)) Is
Nothing) Then
'in A15
Set mySheet = Sheet14
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL14)) Is
Nothing) Then
'in A16
Set mySheet = Sheet35
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL15)) Is
Nothing) Then
'in A17
Set mySheet = Sheet36
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL16)) Is
Nothing) Then
'in A18
Set mySheet = Sheet37
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL1)) Is
Nothing) Then
'in A22
Set mySheet = Sheet15
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL2)) Is
Nothing) Then
'in A23
Set mySheet = Sheet16
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL3)) Is
Nothing) Then
'in A24
Set mySheet = Sheet17
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL4)) Is
Nothing) Then
'in A25
Set mySheet = Sheet18
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL5)) Is
Nothing) Then
'in A26
Set mySheet = Sheet19
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL6)) Is
Nothing) Then
'in A27
Set mySheet = Sheet20
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL7)) Is
Nothing) Then
'in A28
Set mySheet = Sheet21
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL8)) Is
Nothing) Then
'in A29
Set mySheet = Sheet22
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL9)) Is
Nothing) Then
'in A30
Set mySheet = Sheet23
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL10)) Is
Nothing) Then
'in A31
Set mySheet = Sheet24
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL11)) Is
Nothing) Then
'in A32
Set mySheet = Sheet25
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL12)) Is
Nothing) Then
'in A33
Set mySheet = Sheet38
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL13)) Is
Nothing) Then
'in A34
Set mySheet = Sheet39
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL14)) Is
Nothing) Then
'in A35
Set mySheet = Sheet40
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL15)) Is
Nothing) Then
'in A36
Set mySheet = Sheet26
Else
'not in either cell
Exit Sub
End If

sSheetName = .Value 'or .text if you have it formatted nicely

If Not sSheetName = "" Then
On Error Resume Next
mySheet.Name = sSheetName
If Err.Number <> 0 Then
MsgBox sERROR & .Address(0, 0)
End If
On Error GoTo 0
End If
End With
End Sub
 
Sorry to be so unclear in my last post. This is what I was talking
about. It works absolute perfectly its just alot of code

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Const sTOURCELL1 As String = "A3"
Const sTOURCELL2 As String = "A4"
Const sTOURCELL3 As String = "A5"
Const sTOURCELL4 As String = "A6"
Const sTOURCELL5 As String = "A7"
Const sTOURCELL6 As String = "A8"
Const sTOURCELL7 As String = "A9"
Const sTOURCELL8 As String = "A10"
Const sTOURCELL9 As String = "A11"
Const sTOURCELL10 As String = "A12"
Const sTOURCELL11 As String = "A13"
Const sTOURCELL12 As String = "A14"
Const sTOURCELL13 As String = "A15"
Const sTOURCELL14 As String = "A16"
Const sTOURCELL15 As String = "A17"
Const sTOURCELL16 As String = "A18"
Const sPLAYERNAMECELL1 As String = "A22"
Const sPLAYERNAMECELL2 As String = "A23"
Const sPLAYERNAMECELL3 As String = "A24"
Const sPLAYERNAMECELL4 As String = "A25"
Const sPLAYERNAMECELL5 As String = "A26"
Const sPLAYERNAMECELL6 As String = "A27"
Const sPLAYERNAMECELL7 As String = "A28"
Const sPLAYERNAMECELL8 As String = "A29"
Const sPLAYERNAMECELL9 As String = "A30"
Const sPLAYERNAMECELL10 As String = "A31"
Const sPLAYERNAMECELL11 As String = "A32"
Const sPLAYERNAMECELL12 As String = "A33"
Const sPLAYERNAMECELL13 As String = "A34"
Const sPLAYERNAMECELL14 As String = "A35"
Const sPLAYERNAMECELL15 As String = "A36"
Const sPLAYERNUMBERCELL1 As String = "B22"
Const sPLAYERNUMBERCELL2 As String = "B23"
Const sPLAYERNUMBERCELL3 As String = "B24"
Const sPLAYERNUMBERCELL4 As String = "B25"
Const sPLAYERNUMBERCELL5 As String = "B26"
Const sPLAYERNUMBERCELL6 As String = "B27"
Const sPLAYERNUMBERCELL7 As String = "B28"
Const sPLAYERNUMBERCELL8 As String = "B29"
Const sPLAYERNUMBERCELL9 As String = "B30"
Const sPLAYERNUMBERCELL10 As String = "B31"
Const sPLAYERNUMBERCELL11 As String = "B32"
Const sPLAYERNUMBERCELL12 As String = "B33"
Const sPLAYERNUMBERCELL13 As String = "B34"
Const sPLAYERNUMBERCELL14 As String = "B35"
Const sPLAYERNUMBERCELL15 As String = "B36"

Const sERROR As String = "Invalid worksheet name in cell "

Dim sSheetName As String
Dim mySheet As Object

With Target

'only one cell at a time
If .Cells.Count > 1 Then Exit Sub

If Not (Intersect(.Cells, Me.Range(sTOURCELL1)) Is Nothing)
Then
'in A3
Set mySheet = Sheet2
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL2)) Is
Nothing) Then
'in A4
Set mySheet = Sheet3
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL3)) Is
Nothing) Then
'in A5
Set mySheet = Sheet4
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL4)) Is
Nothing) Then
'in A6
Set mySheet = Sheet5
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL5)) Is
Nothing) Then
'in A7
Set mySheet = Sheet6
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL6)) Is
Nothing) Then
'in A8
Set mySheet = Sheet7
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL7)) Is
Nothing) Then
'in A9
Set mySheet = Sheet8
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL8)) Is
Nothing) Then
'in A10
Set mySheet = Sheet9
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL9)) Is
Nothing) Then
'in A11
Set mySheet = Sheet10
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL10)) Is
Nothing) Then
'in A12
Set mySheet = Sheet11
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL11)) Is
Nothing) Then
'in A13
Set mySheet = Sheet12
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL12)) Is
Nothing) Then
'in A14
Set mySheet = Sheet13
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL13)) Is
Nothing) Then
'in A15
Set mySheet = Sheet14
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL14)) Is
Nothing) Then
'in A16
Set mySheet = Sheet35
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL15)) Is
Nothing) Then
'in A17
Set mySheet = Sheet36
ElseIf Not (Intersect(.Cells, Me.Range(sTOURCELL16)) Is
Nothing) Then
'in A18
Set mySheet = Sheet37
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL1)) Is
Nothing) Then
'in A22
Set mySheet = Sheet15
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL2)) Is
Nothing) Then
'in A23
Set mySheet = Sheet16
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL3)) Is
Nothing) Then
'in A24
Set mySheet = Sheet17
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL4)) Is
Nothing) Then
'in A25
Set mySheet = Sheet18
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL5)) Is
Nothing) Then
'in A26
Set mySheet = Sheet19
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL6)) Is
Nothing) Then
'in A27
Set mySheet = Sheet20
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL7)) Is
Nothing) Then
'in A28
Set mySheet = Sheet21
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL8)) Is
Nothing) Then
'in A29
Set mySheet = Sheet22
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL9)) Is
Nothing) Then
'in A30
Set mySheet = Sheet23
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL10)) Is
Nothing) Then
'in A31
Set mySheet = Sheet24
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL11)) Is
Nothing) Then
'in A32
Set mySheet = Sheet25
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL12)) Is
Nothing) Then
'in A33
Set mySheet = Sheet38
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL13)) Is
Nothing) Then
'in A34
Set mySheet = Sheet39
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL14)) Is
Nothing) Then
'in A35
Set mySheet = Sheet40
ElseIf Not (Intersect(.Cells, Me.Range(sPLAYERCELL15)) Is
Nothing) Then
'in A36
Set mySheet = Sheet26
Else
'not in either cell
Exit Sub
End If

sSheetName = .Value 'or .text if you have it formatted nicely

If Not sSheetName = "" Then
On Error Resume Next
mySheet.Name = sSheetName
If Err.Number <> 0 Then
MsgBox sERROR & .Address(0, 0)
End If
On Error GoTo 0
End If
End With
End Sub
 
Maybe something like:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Const sERROR As String = "Invalid worksheet name in cell "

Dim sSheetName As String
Dim mySheet As Object

With Target

'only one cell at a time
If .Cells.Count > 1 Then Exit Sub

Select Case Target.Address(0, 0)
Case Is = "A3": Set mySheet = Sheet2
Case Is = "A4": Set mySheet = Sheet3
Case Is = "A5": Set mySheet = Sheet4
'I'm too lazy...
Case Is = "A36": Set mySheet = Sheet26
Case Else
Exit Sub
End Select

sSheetName = .Value 'or .text if you have it formatted nicely

If Not sSheetName = "" Then
On Error Resume Next
mySheet.Name = sSheetName
If Err.Number <> 0 Then
MsgBox sERROR & .Address(0, 0)
End If
On Error GoTo 0
End If
End With
End Sub

Make sure you use A3, not a3. The comparison is case sensitive.
 
Thank you ever so much. I can't believe how helpful you have been. You
are both amazing and patient to stick with me for the last 10 days. I
wish there was some way to reward you for your time.
 
Back
Top