How to listen to "rename sheet"

[Ben]

Hi

I'd like to create a listener on the event "sheet.name changing". It
apparently does not exist in vba worksheet standard callbacks.
(said in a different way I want to run a function any time a specific
sheet has its name manually changed)
Any idea ? Any help would be appreciated.

Thanks

 

[Guest]

Changing a sheet name does not fire any events. Why do you need to know when
a sheet name has been changed? Perhaps there is a way around this.

 

[Chip Pearson]

Ben,

There is no event triggered when a sheet is deleted or renamed. The closest
you can get, I think, it to keep an array of existing sheet names and then
compare that list to the actual sheet names in a SelectionChange event. Put
the first code block in a class named CSheetChange and the second block of
code in the ThisWorkbook module. ThisWorkbook will sink events raised by
CSheetChange when a sheet is detected to have been added, deleted, or
renamed.


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CSheetChange Class
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private WithEvents WB As Workbook
Private Arr() As String
Public EnableEvents As Boolean

Public Event AfterSheetNameChange(OldName As String, NewName As String)
Public Event AfterSheetDelete(OldName As String)
Public Event AfterSheetAdd(NewName As String)

Public Property Set TheWorkbook(WBook As Workbook)
Dim N As Long
Set WB = WBook
With WB.Sheets
ReDim Arr(1 To .Count)
For N = 1 To .Count
Arr(N) = .Item(N).Name
Next N
End With
End Property



Private Sub Class_Initialize()
Me.EnableEvents = True
End Sub

Private Sub WB_NewSheet(ByVal Sh As Object)
Dim N As Long
With WB.Sheets
ReDim Arr(1 To .Count)
For N = 1 To .Count
Arr(N) = .Item(N).Name
Next N
If Me.EnableEvents = True Then
RaiseEvent AfterSheetAdd(Sh.Name)
End If
End With
End Sub

Private Sub WB_Open()
Dim N As Long
With WB.Sheets
ReDim Arr(1 To .Count)
For N = 1 To .Count
Arr(N) = .Item(N).Name
Next N
End With
Me.EnableEvents = True
End Sub



Private Sub WB_SheetActivate(ByVal Sh As Object)
WB_SheetSelectionChange Sh, Nothing
End Sub

Private Sub WB_SheetDeactivate(ByVal Sh As Object)
WB_SheetSelectionChange Sh, Nothing
End Sub

Private Sub WB_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)

Dim N As Long
Dim M As Long
With WB.Sheets
If .Count = UBound(Arr) Then
''''''''''''''''''''''''''''''
' Same number of sheet. check
' for rename.
'''''''''''''''''''''''''''''
For N = 1 To .Count
If StrComp(Arr(N), .Item(N).Name, vbBinaryCompare) <> 0 Then
If Me.EnableEvents = True Then
RaiseEvent AfterSheetNameChange(Arr(N), .Item(N).Name)
End If
Arr(N) = .Item(N).Name
Exit Sub
End If
Next N
ElseIf .Count < UBound(Arr) Then
'''''''''''''''''''''''''''''''
' Sheet has been deleted.
'''''''''''''''''''''''''''''''
For N = 1 To .Count
If StrComp(Arr(N), .Item(N).Name, vbBinaryCompare) <> 0 Then
If Me.EnableEvents = True Then
RaiseEvent AfterSheetDelete(Arr(N))
End If
For M = N To .Count
Arr(M) = .Item(M).Name
Next M
ReDim Preserve Arr(1 To .Count)
End If
Next N
End If
End With

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END CSheetChange
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ThisWorkbook Module
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''
' Declare the class variable WithEvents so we
' can get events.
''''''''''''''''''''''''''''''''''''''''''''''''
Private WithEvents SheetChanger As CSheetChange

Public Sub SetupChanger()
'''''''''''''''''''''''''''''''''''''''
' Setup SheetChanger
'''''''''''''''''''''''''''''''''''''''
Set SheetChanger = New CSheetChange
Set SheetChanger.TheWorkbook = Me
SheetChanger.EnableEvents = True
End Sub

Private Sub SheetChanger_AfterSheetAdd(NewName As String)
MsgBox "After Sheet Add:" & vbCrLf & _
"Name: " & NewName
End Sub

Private Sub SheetChanger_AfterSheetDelete(OldName As String)
MsgBox "After Delete: " & vbCrLf & _
"Old Name: " & OldName
End Sub

Private Sub SheetChanger_AfterSheetNameChange(OldName As String, NewName As
String)
MsgBox "After Name Change:" & vbCrLf & _
"Old Name: " & OldName & vbCrLf & _
"New Name: " & NewName

End Sub


Private Sub Workbook_Open()
SetupChanger
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' END ThisWorkbook
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)