Private VBA Apply to all New Worksheets

[patricevease]

Hi All,

I have a private VBA designed to automatically rename the sheet name based on a cell value. (Within the code it is said to ignore certain sheets). The problem I have at the moment is that I have to apply this VBA to all worksheets manually within the "Microsoft Excel Objects" section of the VBA's (essentially applies the code to the whole sheet). How can I have it so that my private sub will automatically apply to all new and existing worksheets? I have posted the code below.



Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If ActiveSheet.Name = "Lists" Then Exit Sub
If ActiveSheet.Name = "ClientTemplate" Then Exit Sub
If ActiveSheet.Name = "ClientTemplateBackup" Then Exit Sub
If Target.Address <> "$C$2" 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





Thanks in advance for your time and help!

[snb]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$C$2" Or Target = "" Then Exit Sub
If InStr("|Lists|ClientTemplate|ClientTemplateBackup|", "|" & Sh.Name & "|") Then Exit Sub



End Sub

[patricevease]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address <> "$C$2" Or Target = "" Then Exit Sub
If InStr("|Lists|ClientTemplate|ClientTemplateBackup|", "|" & Sh.Name & "|") Then Exit Sub



End Sub

Hi Snd thanks for your response. I've shortened my code using the one you have posted (thankyou!) however the idea was that I didn't have to copy and paste this code for each of existing/new sheets being created. Do you know how I should do that so I only have to enter it once somewhere?

[snb]

That's exactly what I showed you....

[mancubus]

did you copy the code to ThisWorkbook code module?

[SamT]

Only replace this part in your code with snb's code

Private Sub Worksheet_Change(ByVal Target As Range)
'Specify the target cell whose entry shall be the sheet tab name.
If ActiveSheet.Name = "Lists" Then Exit Sub
If ActiveSheet.Name = "ClientTemplate" Then Exit Sub
If ActiveSheet.Name = "ClientTemplateBackup" Then Exit Sub
If Target.Address <> "$C$2" Then Exit Sub
'If the target cell is empty (contents cleared) then do not change the shet name
If IsEmpty(Target) Then Exit Sub

Put the resulting code in the ThisWorkbook Code Page only.



In my personal opinion, you are overloading the Event Procedure. I would rename the Sub to something like Sub RenameByC2 and put it in a standard module with a Code Name like modAllSheets. Then I would rewrite the Event Procedure to

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = "$C$2" Then modAllSheets.RenameByC2 Sh, Target
End Sub
That way, if you want to run another procedure on say, Sheet Lists only, you can add one line to Workbook_SheetChange.

If Target Is Sheets("List").Range(A1") then SomeListSheetSub
'Or
If Sh.Name = "List" Then
If Target.Address = "$A$1" Then SomeListSheetSub
If Target.Address = "$Z$26" Then SomeOtherListSheetSub
ElseIf Sh.Name = "SomeOther SheetName" Then
'More options
End If
The idea is that the only purpose of an Event Procedure is to look at where the Event occurred and decide wihch other Procedure to run.

Note that I include the Module name in Calls, (modAllSheets.RenameByC2,) in a large project for future reference when I have forgotten all about the code and have to decipher what is going on with it.

[patricevease]

The idea is that the only purpose of an Event Procedure is to look at where the Event occurred and decide wihch other Procedure to run.

Note that I include the Module name in Calls, (modAllSheets.RenameByC2,) in a large project for future reference when I have forgotten all about the code and have to decipher what is going on with it.

Thank you very much for all this SamT! Much appreciated and will help loads :-)