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

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

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
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
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.


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
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.


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
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.


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

Forum statistics

Threads
1,223,894
Messages
6,175,252
Members
452,623
Latest member
Techenthusiast

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