Worksheet Tab Name Based on Cell Value
Hi,
I want to create a vba macro that will allow me to automatically rename a tab for a worksheet to the value that has been returned to a cell (a calculated value, not a value that I typed in myself). I have a massive worksheet and hence do not want to rename every worksheet, but selected worksheets.
The following vba is what I am using at the moment but it does not return the "A5" cell value each time unless I retype the value in cell A5. The value in cell A5 is a value that has been returned via calculation hence I know I should have used worksheet_calculate, but this tends to execute infinitely. I tried making one (see below) which tend to work fine, but but not quite – the sheet tab names I want changed (‘target’ sheets) depend on a selection in a ‘main’ sheet. So, after putting the above code in a target sheet whose tab name I need changed, I go to the ‘main’ sheet to a drop down list to choose the required selection, which then automatically makes a change in cell A1 of the target sheets – as the code below wrote works on the ActiveSheet, the code changes the tab name of my main sheet (as this is where I go to make my selection which activates the change in A1 of the target sheet based on a formula), rather than my target sheet.
Is there any way you can amend the above code so that my target sheet tab name changes rather than my main sheet tab name?
I’m very new with VBA, so if you could list out the exact changes that I would need to make, that would be greatly appreciated! Thank you.
Code:
Private Sub Worksheet_Calculate()
With Range("A5")
If Len(.Value) = 0 Or Len(.Value) > 31 Then Exit Sub
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(.Text, (IllegalCharacter(i))) > 0 Then
MsgBox "The formula in cell A5 returns a value containing a character that violates sheet naming rules." & vbCrLf & _
"Recalculate the formula without the ''" & IllegalCharacter(i) & "'' character.", _
48, "Not a possible sheet name !!"
Exit Sub
End If
Next i
Dim strSheetName As String, wks As Worksheet, bln As Boolean
strSheetName = (.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 bln = False Then
ActiveSheet.Name = strSheetName
ElseIf ActiveSheet.Name <> .Text Then
MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
"Recalculate the formula in cell A5 to return a unique name."
End If
End With
End Sub
