Rename worksheet tab based on cell value on same worksheet (cell value is calculated from another worksheet)

[surveyingguy]

Hi guys,

First time poster, have frequently referred to this site for answers in the past, finally posting a query as I just can't find an answer anywhere.

Im reasonably proficient in excel and used VBA by finding appropriate code online, however, for the problem I have I just can't find an answer despite much searching.....

I have multiple tabs where the value in cell A4 is pulled from a summary page. Lets call the page the info is located on as "Summary".

The multiple tabs which derive from the summary page take the info in a logical manner ie
Summary page shows the following;

Stephen
John (Cell A1)
David (Cell A2)
Barry (Cell A3)
etc
etc

The multiple tabs which follow take this info sequentially into cell A4, ie;
1st Tab Cell A4 shows John
2nd Tab Cell A4 shows David
etc
etc

The current VBA code I have is fairly detailed and was sourced from a forum online. It works almost exactly how I want it to. Here is the code;

Private Sub Worksheet_Change(ByVal Target As Range)
    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> "$A$4" Then Exit Sub
        'If the target cell is empty (contents cleared) then do not change the shet 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

Basically its function is to update the tab name with whatever is within Cell A4 on that same worksheet (which is of course taken from "Summary" worksheet). It has error checking within it to ensure that no illegal characters are entered, the length does not exceed the limit, whether another tab already has this name. If this is the case an error message appears and it doesn't change the tab name.

What is happening however, is that when i change the data on the summary page, whilst this carries the information forward to the relevant worksheet and changes the data in Cell A4 of that worksheet, it doesn't automatically change the worksheet name in the tab. To do this i need to manually click in Cell A4 and hit ENTER. I don't want to have to manually do this, particularly as i have hundreds of these worksheets. I want it to be automatic so that when i change the data on the summary page, as well as changing the data in Cell A4 on the target worksheet, it automatically changes the worksheet name in the tab.

I have found code which, in isolation, achieves this and appears to be a fairly basic piece of code;

Private Sub Worksheet_Calculate()
On Error Resume Next
Sheet1.Name = Range("A4").Value
End Sub

(Where "Sheet1" is replaced by the actual name of the relevant worksheet)

I just cant work out where to slip this code into my original code above to make it work?

Any help would be greatly appreciated, im absolutely stumped. Hopefully ive given enough info/detail above to allow one of you experts out there to assist me, if theres anything im not clarifying well enough please let me know.

 

[steve the fish]

Re: Help to rename worksheet tab based on cell value on same worksheet (cell value is calculated from another worksheet)

Obviously I cant see your make up but from what you describe I think id go like this:

Place this in standard module:

Function RemoveIllegalChar(myString As String)

Dim a As String
Dim b As String
Dim i As Integer

Const IllegalChar = "/[]*?:"
Const RegularChar = "      "

For i = 1 To Len(IllegalChar)
    a = Mid(IllegalChar, i, 1)
    b = Mid(RegularChar, i, 1)
    myString = Replace(myString, a, b)
Next

RemoveIllegalChar = myString

End Function

Then place this in workbook module:

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

myStr = Sh.Range("A4").Value
myStr = Trim(RemoveIllegalChar(CStr(myStr)))

If Len(myStr) > 0 And Len(myStr) < 32 Then
    For Each Sht In ThisWorkbook.Worksheets
        If UCase(Sht.Name) = UCase(myStr) Then
            Exit Sub
        End If
    Next
    Sh.Name = myStr
End If

End Sub

 

[Tuan Kriel]

Re: Help to rename worksheet tab based on cell value on same worksheet (cell value is calculated from another worksheet)

Thank you, thank you, thank you!
Very simplified and efficient.

 

[egelsct]

Re: Help to rename worksheet tab based on cell value on same worksheet (cell value is calculated from another worksheet)

I like this coding especially since I'm using a sheet as a template that gets copied via a macro. Some reason nothing happens when I change the information in the cell. Any suggestions?