Dynamic sheet names based on dependent cells - excel

Question

Apologies if this is simple, but I am new to VBA. I am attempting to set up the my Excel sheet so that when certain cells in the first sheet are changed (eg A1, A2, A3, A4) the names of four other sheets will change to match them. I have found the following formula which works if I change the specific cell on that sheet;
`
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Set Target = Range("A1")
If Target = "" Then Exit Sub
On Error GoTo Badname
ActiveSheet.Name = Left(Target, 31)
Exit Sub
Badname:
MsgBox "Please revise the entry in A1." & Chr(13) _
& "It appears to contain one or more " & Chr(13) _
& "illegal characters." & Chr(13)
Range("A1").Activate
End Sub
` Unfortunately it will not work if I change A1 to be dependent on one of the four cells on the main sheet specified previously, as it only looks for changes in the sheet it is saved in.
Is there a way to use VBA to look at a cell in one sheet and then change the sheet name of another sheet to match?
Thanks

Answer 1

Like I mentioned in the comments, it's not that simple to rename the sheet. You have to check for so many things.
My Assumptions
You have 5 Sheets in a workbook; Sheet1, Sheet2, Sheet3, Sheet4 and Sheet5
When you change cells in Sheet5, depending on the cell which changes, Sheets1-4's names are changed
I am assuming that when A1 changes, Sheet1 is renamed. When A2 changes, Sheet2 is renamed and so on...
Logic
Use Worksheet_Change event to trap changes to cell A1, A2, A3 or A4
Use Sheet CodeName to change the name
Check if the sheet name is valid. A sheet name cannot contain any of these Characters \ / * ? [ ]
Check if you already have a sheet with the name you want to use for renaming
If everything is hunky dory then go ahead and replace
Code
See this example. This code goes in the Sheet5 code area.
Dim sMsg As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wsName As String
On Error GoTo Whoa
sMsg = "Success"
Application.EnableEvents = False
If Not Target.Cells.CountLarge > 1 Then
If Not Intersect(Target, Range("A1")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet1], wsName
ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet2], wsName
ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet3], wsName
ElseIf Not Intersect(Target, Range("A4")) Is Nothing Then
wsName = Left(Target, 31)
RenameSheet [Sheet4], wsName
End If
End If
MsgBox sMsg
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
'~~> Procedure actually renames the sheet
Sub RenameSheet(ws As Worksheet, sName As String)
If IsNameValid(sName) Then
If sheetExists(sName) = False Then
ws.Name = sName
Else
sMsg = "Sheet Name already exists. Please check the data"
End If
Else
sMsg = "Invalid sheet name"
End If
End Sub
'~~> Check if sheet name is valid
Function IsNameValid(sWsn As String) As Boolean
IsNameValid = True
'~~> A sheet name cannot contain any of these Characters \ / * ? [ ]
For i = 1 To Len(sWsn)
Select Case Mid(sWsn, i, 1)
Case "\", "/", "*", "?", "[", "]"
IsNameValid = False
Exit For
End Select
Next
End Function
'~~> Check if the sheet exists
Function sheetExists(sWsn As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sWsn)
On Error GoTo 0
If Not ws Is Nothing Then sheetExists = True
End Function
Screenshot