VBA - When Cell Change, Get the Value in that cell and Rename an Existing Worksheet

S

sk2018

New Member
Joined
Jul 7, 2018
Messages
26
Office Version
  1. 2016
Platform
  1. Windows
Need some help here, guys.
Not a VBA pro, and I have tried my best to amend it but just couldn't solve it.

I have 2 worksheets in my XLSM.
Worksheet 1 is Taylor.
Worksheet 2 is Overall.
I want to rename Taylor worksheet based on a dynamic value enter in Overall worksheet cell E6 and append it with "-Score"
Eg: I enter "ABC" in cell E6 at Overall worksheet. Then my Taylor worksheet would auto rename it to "ABC-Score".

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> Sheets("Overall").Range("E6") Then Exit Sub
        'If the target cell is empty (contents cleared) then do not change the sheet name
    If IsEmpty(Target) Then Exit Sub


    'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
    If Len(Target.Value) > 31 Then
        MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
        "You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If


    'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
    'Verify that none of these characters are present in the cell's entry.
    Dim IllegalCharacter(1 To 7) As String, i As Integer
    IllegalCharacter(1) = "/"
    IllegalCharacter(2) = "\"
    IllegalCharacter(3) = "["
    IllegalCharacter(4) = "]"
    IllegalCharacter(5) = "*"
    IllegalCharacter(6) = "?"
    IllegalCharacter(7) = ":"
    For i = 1 To 7
        If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
            MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
            "Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        End If
    Next i


    'Verify that the proposed sheet name does not already exist in the workbook.
    Dim strSheetName As String, wks As Worksheet, bln As Boolean
    strSheetName = Trim(Target.Value)
    On Error Resume Next
    Sheets("Taylor").Name = strSheetName & "-Score"
    On Error Resume Next
    If Not wks Is Nothing Then
        bln = True
    Else
        bln = False
        Err.Clear
    End If


    'If the worksheet name does not already exist, name the active sheet as the target cell value.
    'Otherwise, advise the user that duplicate sheet names are not allowed.
    If bln = False Then
        ActiveSheet.Name = strSheetName
    Else
        MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
        "Please enter a unique name for this sheet."
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
    End If


End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Try changing this line:
Code: 
If Target.Address <> Sheets("Overall").Range("E6") Then Exit Sub
to this:
Code: 
If Target.Address <> Sheets("Overall").Range("E6")[B][COLOR=#ff0000].Address[/COLOR][/B] Then Exit Sub
Otherwise, you are comparing a String to a Range object.
 
Upvote 0
Joe4 said:
Try changing this line:
Code: 
If Target.Address <> Sheets("Overall").Range("E6") Then Exit Sub
to this:
Code: 
If Target.Address <> Sheets("Overall").Range("E6")[B][COLOR=#ff0000].Address[/COLOR][/B] Then Exit Sub
Otherwise, you are comparing a String to a Range object.
Click to expand...


Changed as per your advice.
Still not working though.

Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If Target.Address <> Sheets("Overall").Range("E6").Address Then Exit Sub
'If the target cell is empty (contents cleared) then do not change the sheet name
If IsEmpty(Target) Then Exit Sub


'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
If Len(Target.Value) > 31 Then
MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
"You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If


'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
'Verify that none of these characters are present in the cell's entry.
Dim IllegalCharacter(1 To 7) As String, i As Integer
IllegalCharacter(1) = "/"
IllegalCharacter(2) = ""
IllegalCharacter(3) = "["
IllegalCharacter(4) = "]"
IllegalCharacter(5) = "*"
IllegalCharacter(6) = "?"
IllegalCharacter(7) = ":"
For i = 1 To 7
If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
"Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
Exit Sub
End If
Next i


'Verify that the proposed sheet name does not already exist in the workbook.
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = Trim(Target.Value)
On Error Resume Next
Sheets("Taylor").Name = strSheetName & "-Score"
On Error Resume Next
If Not wks Is Nothing Then
bln = True
Else
bln = False
Err.Clear
End If


'If the worksheet name does not already exist, name the active sheet as the target cell value.
'Otherwise, advise the user that duplicate sheet names are not allowed.
If bln = False Then
ActiveSheet.Name = strSheetName
Else
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Please enter a unique name for this sheet."
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If


End Sub
 
Upvote 0
What is it doing, if anything?

Place a line break at the line we edited, then try again. It should run your VBA up to that point.
Then you can open the VB Editor, and use F8 to proceed line-by-line through your code.
Watch what happens, and see if it exits the code, or gets to the point where it is supposed to rename your sheet.
 
Upvote 0
Joe4 said:
What is it doing, if anything?

Place a line break at the line we edited, then try again. It should run your VBA up to that point.
Then you can open the VB Editor, and use F8 to proceed line-by-line through your code.
Watch what happens, and see if it exits the code, or gets to the point where it is supposed to rename your sheet.
Click to expand...


My first line is Private Sub Worksheet_Change(ByVal Target As Range)
I tried putting breakpoint and use F8 to debug, there's just no response.
Like totally not working.
I tried re-position cursor. Not working too
 
Upvote 0
It sounds like you may have events disabled. That can happen if your code exits before turning it back on.

Try running this code manually:
Code: 
Sub ReenableEvents()
[COLOR=#333333]    Application.EnableEvents = True
End Sub[/COLOR]

In the code below, add the line in blue, and put the line break on the line in red in your code:
Code: 
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[COLOR=#333333]'Specify the target cell whose entry shall be the sheet tab name.
[/COLOR][COLOR=#0000ff]MsgBox "Code is Running"[/COLOR]
[COLOR=#ff0000]If Target.Address <> Sheets("Overall").Range("E6").Address Then Exit Sub
[/COLOR]...
The "Code is Running" should show up every time you make a change to any cell. If it does not, then your events are not enabled.
Once you have everything working the way you want, you can remove that line.
 
Upvote 0
Joe4 said:
It sounds like you may have events disabled. That can happen if your code exits before turning it back on.

Try running this code manually:
Code: 
Sub ReenableEvents()
[COLOR=#333333]    Application.EnableEvents = True
End Sub[/COLOR]

In the code below, add the line in blue, and put the line break on the line in red in your code:
Code: 
[COLOR=#333333]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR]
[COLOR=#333333]'Specify the target cell whose entry shall be the sheet tab name.
[/COLOR][COLOR=#0000ff]MsgBox "Code is Running"[/COLOR]
[COLOR=#ff0000]If Target.Address <> Sheets("Overall").Range("E6").Address Then Exit Sub
[/COLOR]...
The "Code is Running" should show up every time you make a change to any cell. If it does not, then your events are not enabled.
Once you have everything working the way you want, you can remove that line.
Click to expand...


Awesome. Thanks a lot.
I made minor amendments to it too - cutting down some logic.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> Sheets("Overall").Range("E6").Address Then Exit Sub
    
        'If the target cell is empty (contents cleared) then do not change the sheet name
    If IsEmpty(Target) Then Exit Sub




    'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
    If Len(Target.Value) > 31 Then
        MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
        "You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
        Application.EnableEvents = False
        Target.ClearContents
        Application.EnableEvents = True
        Exit Sub
    End If




    'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
    'Verify that none of these characters are present in the cell's entry.
    Dim IllegalCharacter(1 To 7) As String, i As Integer
    IllegalCharacter(1) = "/"
    IllegalCharacter(2) = "\"
    IllegalCharacter(3) = "["
    IllegalCharacter(4) = "]"
    IllegalCharacter(5) = "*"
    IllegalCharacter(6) = "?"
    IllegalCharacter(7) = ":"
    For i = 1 To 7
        If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
            MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
            "Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
            Exit Sub
        End If
    Next i




    'Verify that the proposed sheet name does not already exist in the workbook.
    Dim strSheetName As String, wks As Worksheet, bln As Boolean
    strSheetName = Trim(Target.Value)
    On Error Resume Next
    Sheets("Taylor").Name = strSheetName & "-Score"
    On Error Resume Next
    If Not wks Is Nothing Then
        bln = True
    Else
        bln = False
        Err.Clear
    End If




End Sub

Thanks a lot!!!
 
Upvote 0
You are welcome.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Adjusting Code to Change a Worksheet Name to Upper Case
Replies
1
Views
328
Snake Eyes
S
D
  • Question
VBA naming a worksheet via cells
Replies
0
Views
471
Dexter73
D
S
  • Question
Worksheet Change Event
Replies
2
Views
378
sspatriots
S
S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
372
sspatriots
S
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
325
sspatriots
S

Forum statistics

Threads
1,214,938
Messages
6,122,346
Members
449,080
Latest member
Armadillos

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top