[dba-Tech] Excel Sheet Tab Naming routine

[Paul Hartland]

I assume you have debugged the code to ensure this line gets $B$1 at some
point and not just B1

If Target.Address <> "$B$1" Then Exit Sub

Paul



On Mon, 29 Apr 2019, 05:02 John Bartow via dba-Tech, <
dba-tech at databaseadvisors.com> wrote:

> Hi All,
> I have a roster of names on the first sheet.
> Each sheet after that copies the name from one line in the roster:
> =Roster!B3&" "&Roster!C3 into cell B1 of the sheet.
> I'm trying to use the routine listed below to rename sheets based on the
> text of Cell B1.
> This doesn't work, can someone spot why?
>
>
> ----------------------------------------------------------------------------------------------
> Private Sub Worksheet_Change(ByVal Target As Range)
> 'Specify the target cell whose entry shall be the sheet tab name.
> If Target.Address <> "$B$1" Then Exit Sub
> 'If the target cell is empty (contents cleared) do not change the sheet
> name.
> If IsEmpty(Target) Then Exit Sub
>
> 'Disallow the entry if it is greater than 31 characters.
> If Len(Target.Value) > 31 Then
> MsgBox "Worksheet names cannot be more than 31 characters." & vbCrLf & _
> Target.Value & " has " & Len(Target.Value) & " characters.", _
> 48, "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 &
> _
> "Enter a 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.Text)
> 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 sheet as 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
>
> TIA
> John B
>
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com
>