VBA to auto-populate tab name from cell value-CodePudding

I want to start by saying that I am a teacher and have very little experience coding. I only have a cursory understanding of how to manipulate cell values in pre-existing code. I created a spreadsheet for my school district to help teachers streamline the creation of student progress reports. On the .xlsm file I used the following code to auto-populate tab names based on the contents of cell "b1" in the same tab. I found this code on a forum. It worked well for a few years, but suddenly this year the code does not work. The code fails and displays the message box delineated in the vba code that the source cell contains illegal characters:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Set Target = Range("b1")
    If Target = "" Then Exit Sub
    On Error GoTo Badname
    ActiveSheet.Name = Left(Target, 31)
    Exit Sub
Badname:
    MsgBox "Please revise the entry in b1." & Chr(13) _
    & "It appears to contain one or more " & Chr(13) _
    & "illegal characters." & Chr(13)
    Range("b1").Activate
End Sub

Can this code be fixed? Does excel offer other means to auto-populate tab names from cell values? In case it matters, the cell that I am using as the source for the tab name contains the formula ='class list'!B5. It pulls the desired source text from a different tab and the goal is to have the text that is transferred via the formula to be the source of the tab's name. Is there a way to modify the VBA code to pull the value directly from the source tab? I could understand if it is the formula in "b1" that is causing the problem? But it is a mystery to me why, after working for several previous years, the problem is only now manifesting...

One other issue with this VBA code is that it required the user to interact with the cells in the tab before the VBA code would run and change the tab name. Could the code be made to change the tab name as soon as the source cell value changes? Though not strictly necessary this would be a big quality of life improvement.

Thank you so much for your consideration,

Eric

CodePudding user response：

Surprises When Renaming a Worksheet

Sheet Module of the class list Worksheet, e.g. Sheet2(class list) in the Project Explorer

Adjust the destination worksheet's (the one that you will be renaming) code name (Sheet1), the name that is not in parentheses in the Project Explorer.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    RenameWorksheet Target, "B5", Sheet1
End Sub

Standard Module, e.g. Module1

Option Explicit

Sub RenameWorksheet( _
        ByVal Target As Range, _
        ByVal CellAddress As String, _
        ByVal dws As Worksheet)
    
    Dim sws As Worksheet: Set sws = Target.Worksheet
    
    Dim iCell As Range
    Set iCell = Intersect(Target, sws.Range(CellAddress))
    If iCell Is Nothing Then Exit Sub
    
    Dim OldName As String: OldName = dws.Name
    Dim NewName As String: NewName = CStr(iCell.Value)
    
    If StrComp(NewName, OldName, vbTextCompare) <> 0 Then
        ' 1.) Blank Cell
        If Len(NewName) = 0 Then Exit Sub ' the cell is blank
        ' 2.) 31 Character Limit
        If Len(NewName) > 31 Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "A maximum of 31 characters" & vbLf _
                & "is allowed for a sheet name.", vbCritical
            Exit Sub
        End If
        ' 3.) Reserved Name 'History'
        If StrComp(NewName, "History", vbTextCompare) = 0 Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "'" & NewName & "' is a reserved name " & vbLf _
                & "and cannot be used as a sheet name.", vbCritical
            Exit Sub
        End If
        ' 4.) Existence of a Sheet With the Same Name
        Dim sh As Object
        On Error Resume Next
            Set sh = ThisWorkbook.Sheets(NewName)
        On Error GoTo 0
        If Not sh Is Nothing Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "A sheet with the name '" & sh.Name & "'" & vbLf _
                & "already exists in this workbook.", vbCritical
            Exit Sub
        End If
    End If

    Dim ErrNumber As Long
    Dim ErrDescription As String
    
    ' Attempt to rename.
    On Error Resume Next
        dws.Name = NewName
        ErrNumber = Err.Number
        ErrDescription = Err.Description
    On Error Goto 0
    
    If ErrNumber <> 0 Then
        ' 5.) Illegal Characters: ':, \, /, ?, *, [ , ]'
        If Left(ErrDescription, 47) _
                = "You typed an invalid name for a sheet or chart." Then
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "It appears to contain one or more " & vbLf _
                & "illegal characters ("" : \ / ? * [ ] "")", vbCritical
            Exit Sub
        ' 6.) Unexpected error.
        Else
            MsgBox "Please revise the entry in cell 'B5'." & vbLf & vbLf _
                & "Run-time error '" & ErrNumber & "':" & vbLf _
                & ErrDescription, vbCritical
            Exit Sub
        End If
    End If

End Sub

CodePudding user response：

The macro should trigger when the cell is changed, it is a version of the macro in this link: Run Macro when Cell changes

Is your macro in the code for the sheet as described in the above link? I have taken your code and saved it into a sheet in a blank workbook. When I type in to B1 it changes the sheet name. When I linked B1 to another sheet changing the value in the other sheet didn't trigger the macro even though it was indirectly changing B1. i.e. there is nothing wrong with the macro itself You could try a few things:

Check that there are no Bad characters in Class list B5.
Change B1 to a data validation drop down list linked to the class list, that way as you choose the student you are changing the cell.
delete the on error so that the actual error description becomes visible rather than the macros default error description.

CodePudding user response：

It is not a good idea to put this code to run in the Worksheet_SelectionChange event of the worksheet because - as the event name suggests - on each new cell selection it will be triggered. So if the user moves, say, through 10 cells, the sheet will be (re)named at least 9 times. And this is not what you want to happen. Better if you put the code to be triggered eventually by the user (ALT F8, and running the code) or, as a last resort, in order to automate the task, by the SheetActivate event (in the Workboook code pane).

Then you could improve your task this way:

Put this code in a Standard Module:

Option Explicit
 
Sub fnRenameThisSheet()
    Call fnRenameTheSheet(ActiveSheet)
End Sub

Sub fnRenameAllSheets()
    Dim sh As Excel.Worksheet

    For Each sh In ThisWorkbook.Worksheets
        Call fnRenameTheSheet(sh)
    Next

End Sub

Sub fnRenameTheSheet(sh As Excel.Worksheet)
    Dim strSheetName As String
    Dim rngTarget As Excel.Range

    Set rngTarget = sh.Range("B1")
    If Len(rngTarget) = 0 Then Exit Sub
    strSheetName = fnReplaceIllegalChars(Left(rngTarget, 31), "_")
    On Error GoTo Badname 'in case of name alread in use for other sheet
    sh.Name = strSheetName
    
lblExit:
    Exit Sub
    
Badname:
    MsgBox "Please revise the entry in b1." & Chr(13) _
        & "It appears to contain one or more " & Chr(13) _
        & "illegal characters, or the name '" & strSheetName & _
        "' has already been assigned to another sheet. Check out." & Chr(13)
    Range("B1").Activate
End Sub


Function fnReplaceIllegalChars(strIn As String, strToThisChar As String) As String
    Dim strSpecialChars As String
    Dim i As Long
    strSpecialChars = "*:?/\[]"

    For i = 1 To Len(strSpecialChars)
        strIn = Replace(strIn, Mid$(strSpecialChars, i, 1), strToThisChar)
    Next

    fnReplaceIllegalChars = strIn
End Function

And if you really want it as an 'automated way', using the workbook event SheetActivate,

put this code on the Workbook code pane:

Option Explicit

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Call fnRenameTheSheet(sh)
End Sub

To run the macros, except the 'automated way' you hit ALT F8 and then choose one of the tasks there are shown: fnRenameThisSheet to rename the active sheet, or fnRenameAllSheets renaming all them at once.