Sheet naming with VBA based on cell value

[Javi]

Hi All,


I’m trying to modify one of the two codes below so that the work sheet needing the name change does not require that specific sheet to be active or require manual intervention.
This workbook has two sheets currently many more to be added later.

• “Main” summary sheet with data entry fields
• “Sheet1” all data on this worksheet will be referenced from “Main” this worksheet will not be active unless the user is going to print. No edits will ever be made directly on this sheet.

On worksheet “Main” cell C5 contains the name of what I would like “Sheet1” to be renamed

On worksheet “Sheet1” cell A1 is referencing “Main C5”

This configuration works fine with the two below codes, provided I activate sheet1 one and highlight cell A1 and hit enter or make a change somewhere on the sheet.

What I’m trying to accomplish is "Sheet1" to change names without needing any other intervention. When the cell value on worksheet “Main” C5 is changed or modified I would like the worksheet on "Sheet1" name to just change.

Sorry for being so wordy on what maybe should be a very simple question?

My preference would be to use code 2 below as I prefer the error handling but if that’s not possible no big deal.

Code 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Range("A1")
If Target = "" Then Exit Sub
Application.ActiveSheet.Name = VBA.Left(Target, 31)
Exit Sub
End Sub

Code 2

Private Sub Worksheet_Change(ByVal Target As Range)
    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> "$A$1" 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
    Set wks = ActiveWorkbook.Worksheets(strSheetName)
    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

 

[Fluff]

My pleasure.