bernatbosch
Board Regular
- Joined
- Dec 12, 2015
- Messages
- 66
Hi everyone!
I have a workbook with several worksheets, each one of which has a named range called "MyTitle".
Besides, each one of my worksheets also has a drop-down validation list placed in another cell named as "MySheets".
Every time the user manually changes the value of the named range as "MyTitle" I want to catch the event and start a procedure that must contain two sub routines:
1. Rename the active sheet as the new value placed in "MyTitle"
2. Reset the sheets' list for all the sheets of the active workbook
note: In the case that the user intents to enter a worksheet name that already exist, it must be stopped and noticed by a Msgbox.
So I wrote a pair of sub routines based on the "ActiveSheet" to do this and then I located some code in the Worksheet_Change event of each of the worksheet's code modules.
Something like this:
Worksheet_Change(VyVal Target As Range)
Set rng = Me.Range("MyTitle")
If Not Intersect(Target, rng) Is Nothing Then
On Error Resume Next
Call Rename_ActiveSheet
Call Add_SheetsList_ToAllSheets
On Error GoTo 0
Exit Sub
End If
End Sub
As you can see, I try to keep the events code clean and develop the hard job through procedures located in standard code modules. I have these two procedures, which I call from each of the worksheet's own module, placed in a stadard code module:
Public Sub Rename_ActiveSheet()
Dim wk As Workbook
Dim Sh As Worksheet
Dim Rng As Range
Set wk = ActiveWorkbook
Set Sh = wk.ActiveSheet
Set Rng = Sh.Range("MyTitle")
On Error GoTo ErrorHandler
Sh.Name = Rng.value
Exit Sub
ErrorHandler:
MsgBox "This worksheet name already exists. Please choose another one.", , "Sorry"
End Sub
Public Sub Add_SheetsList_ToAllSheets()
ReDim MySheetsList(ActiveWorkbook.Worksheets.Count) As String
MySheetsList(0) = "This File Sheets"
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
MySheetsList(ws.index) = ws.Name
Next
Dim MyComaSeparatedList As String
MyComaSeparatedList = Join(MySheetsList, ",")
' ************************************************************************************************
' INSERT A DROPDOWN MENU TO ALL THE SHEETS OF THE ACTIVE WORKBOOK WITH A RANGE NAMED "MySheets"
' ************************************************************************************************
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
On Error GoTo JumpToNextSheet
With ActiveSheet.Range("MySheets").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=MyComaSeparatedList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveSheet.Range("MySheets") = MySheetsList(0)
JumpToNextSheet:
Next ws
Application.ScreenUpdating = True
End Sub
HERE COMES MY REAL ISSUE:
I want to change this approach to be able to control all these events through the same code located in the ThisWorkbook events code module. Like this, the events will be controled by the same lines of code and I will not have to add and keep the code in every single worksheet's code module.
The problem I have is that I have no experience in using the Workbook_SheetChange event of ThisWorkbook code module, and it looks like the routines I wrote to be controled by the Worksheet_Change event of each of my worksheets code modules cannot be reused so easily in a ThisWorkbook code module (Workbook_SheetChange event).
I've tried and tried and I got something that does some part of the job, but still not completely becasuse the line Call Add_SheetsList_ToAllSheets results in an error.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rng As Range
Set Rng = Me.ActiveSheet.Range("MyTitle")
If Not Application.Intersect(Target, Me.ActiveSheet.Range("MyTitle")) Is Nothing Then
With Application.ActiveSheet
On Error GoTo ErrorHandler
.Name = Target.value
On Error GoTo 0
End With
'Call Add_SheetsList_ToAllSheets (line that returns an error)
Exit Sub
Else
' No cell of Target in in the target range.
Exit Sub
End If
ErrorHandler:
MsgBox "This worksheet name already exists. Please choose another one.", , "Sorry"
End Sub
Actually, what I ignore (and wish to know) is how could I pass code from a standard module through a Workbook_SheetChange event so that I could keep the code there simple while the hard job (the routine) being placed in a standard code module.
I have a workbook with several worksheets, each one of which has a named range called "MyTitle".
Besides, each one of my worksheets also has a drop-down validation list placed in another cell named as "MySheets".
Every time the user manually changes the value of the named range as "MyTitle" I want to catch the event and start a procedure that must contain two sub routines:
1. Rename the active sheet as the new value placed in "MyTitle"
2. Reset the sheets' list for all the sheets of the active workbook
note: In the case that the user intents to enter a worksheet name that already exist, it must be stopped and noticed by a Msgbox.
So I wrote a pair of sub routines based on the "ActiveSheet" to do this and then I located some code in the Worksheet_Change event of each of the worksheet's code modules.
Something like this:
Worksheet_Change(VyVal Target As Range)
Set rng = Me.Range("MyTitle")
If Not Intersect(Target, rng) Is Nothing Then
On Error Resume Next
Call Rename_ActiveSheet
Call Add_SheetsList_ToAllSheets
On Error GoTo 0
Exit Sub
End If
End Sub
As you can see, I try to keep the events code clean and develop the hard job through procedures located in standard code modules. I have these two procedures, which I call from each of the worksheet's own module, placed in a stadard code module:
Public Sub Rename_ActiveSheet()
Dim wk As Workbook
Dim Sh As Worksheet
Dim Rng As Range
Set wk = ActiveWorkbook
Set Sh = wk.ActiveSheet
Set Rng = Sh.Range("MyTitle")
On Error GoTo ErrorHandler
Sh.Name = Rng.value
Exit Sub
ErrorHandler:
MsgBox "This worksheet name already exists. Please choose another one.", , "Sorry"
End Sub
Public Sub Add_SheetsList_ToAllSheets()
ReDim MySheetsList(ActiveWorkbook.Worksheets.Count) As String
MySheetsList(0) = "This File Sheets"
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
MySheetsList(ws.index) = ws.Name
Next
Dim MyComaSeparatedList As String
MyComaSeparatedList = Join(MySheetsList, ",")
' ************************************************************************************************
' INSERT A DROPDOWN MENU TO ALL THE SHEETS OF THE ACTIVE WORKBOOK WITH A RANGE NAMED "MySheets"
' ************************************************************************************************
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
On Error GoTo JumpToNextSheet
With ActiveSheet.Range("MySheets").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=MyComaSeparatedList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ActiveSheet.Range("MySheets") = MySheetsList(0)
JumpToNextSheet:
Next ws
Application.ScreenUpdating = True
End Sub
HERE COMES MY REAL ISSUE:
I want to change this approach to be able to control all these events through the same code located in the ThisWorkbook events code module. Like this, the events will be controled by the same lines of code and I will not have to add and keep the code in every single worksheet's code module.
The problem I have is that I have no experience in using the Workbook_SheetChange event of ThisWorkbook code module, and it looks like the routines I wrote to be controled by the Worksheet_Change event of each of my worksheets code modules cannot be reused so easily in a ThisWorkbook code module (Workbook_SheetChange event).
I've tried and tried and I got something that does some part of the job, but still not completely becasuse the line Call Add_SheetsList_ToAllSheets results in an error.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Rng As Range
Set Rng = Me.ActiveSheet.Range("MyTitle")
If Not Application.Intersect(Target, Me.ActiveSheet.Range("MyTitle")) Is Nothing Then
With Application.ActiveSheet
On Error GoTo ErrorHandler
.Name = Target.value
On Error GoTo 0
End With
'Call Add_SheetsList_ToAllSheets (line that returns an error)
Exit Sub
Else
' No cell of Target in in the target range.
Exit Sub
End If
ErrorHandler:
MsgBox "This worksheet name already exists. Please choose another one.", , "Sorry"
End Sub
Actually, what I ignore (and wish to know) is how could I pass code from a standard module through a Workbook_SheetChange event so that I could keep the code there simple while the hard job (the routine) being placed in a standard code module.