This is my first time using a drop down list. I was wondering if there was a way to assign a macro to each of the items in the drop down list.
For an example if I selected BZ1A I would want it to run the sub I have called BZ1A.
Run Macros From Drop Down
Copy the first code into the sheet module of the worksheet containing the drop down, e.g. Sheet1 (the name in parentheses in the VBE Project Explorer).
Adjust the values in the constants section.
Put your codes into the same module, e.g. Module1. Otherwise you will have to modify the code.
In this example the drop down list is in cell A1 of worksheet Sheet1 and contains the list (values) Sub1, Sub2, Sub3.
Sheet Module e.g. Sheet1
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const CellAddress As String = "A1"
Const ModuleName As String = "Module1"
If Target.Cells.CountLarge = 1 Then
If Not Intersect(Range(CellAddress), Target) Is Nothing Then
Application.EnableEvents = False
On Error GoTo clearError
Application.Run ModuleName & "." & Target.Value
Application.EnableEvents = True
End If
End If
Exit Sub
clearError:
MsgBox "Run-time error '" & Err.Number & "': " & Err.Description
Resume Next
End Sub
Standard Module e.g. Module1 (Example)
Option Explicit
Sub Sub1()
MsgBox "Running 'Sub1'"
End Sub
Sub Sub2()
MsgBox "Running 'Sub2'"
End Sub
Sub Sub3()
MsgBox "Running 'Sub3'"
End Sub
Related
I am trying to test a cell for specific data. If it contains that data, I do not want my code to run (because that would leave my worksheet and workbook Unprotected). If the cell contains data that does not match the test specifics, then I want the code to run. My code is to unprotect the active workbook, then unprotect the active worksheet, then fill the value of cell N41 as the "sheet name", then protect the active worksheet, then protect the active workbook. I want to add the test to the top of the code to avoid security failures.
The data that I want to test the cell for is:
The cell does not contain more than 31 characters (including spaces between charaters)
The cell does not contain any of the following characters: \ / : ? * [ or ]
The cell is not blank (empty)
If any of the above data/characters are in the cell I want the code to not run and leave my password protection in place for both the protected worksheet and protected workbook.
If the cell contains less than 31 characters (including spaces), does not contain any of the unwanted characters, and has at least 1 character in it (not a blank cell) then I want the code to run. Any help would be greatly appreciated.
Private Sub CommandButton16_Click()
ThisWorkbook.Unprotect Password:="Password1"
ActiveSheet.Unprotect Password:="Password2"
ActiveSheet.Name = Range("N41").Value
ActiveSheet.Protect Password:="Password2"
ThisWorkbook.Protect Password:="Password1"
End Sub
I guess the real question is "How to check if some value is the correct name for a worksheet?" in order to minimize the period when the document is not protected, and to eliminate an error when renaming.
From the full list of naming conventions we can learn two additional rules. The name shouldn't be "History" and it shouldn't begin or end with an apostrophe '. Also, there shouldn't be other sheets with that name.
In my opinion, the easiest way to accomplish the main task is to wrap renaming with On Error statements.
Private Sub CommandButton_Click()
Const BookPass = "Password1"
Const SheetPass = "Password2"
Dim NewName as String
Dim ErrCode&, ErrDesc$, ErrMessage$
NewName = Range("N41").Value
With ThisWorkbook
.Unprotect BookPass
With ActiveSheet
.Unprotect SheetPass
On Error Resume Next
' ------ Main Part -------
.Name = NewName
' ------------------------
ErrCode = Err.Number
ErrDesc = Err.Description
On Error GoTo 0
.Protect SheetPass
End With
.Protect BookPass
End With
If ErrCode <> 0 Then
ErrMessage = "NewName=" & NewName & vbNewLine & _
"Error=" & ErrCode & vbNewLine & _
"Description: " & ErrDesc
MsgBox ErrMessage, vbCritical
End If
End Sub
p.s. I suppose, this code will be placed in the worksheet object module. In this case, it is better to replace ActiveSheet with Me for readability.
If you are prepared to weaken the Workbook protection, you can add use this code when protecting the Workbook.
Your code can then change the sheet name without unprotecting the WorkBook, but so can your users.
ActiveWorkbook.Protect Password:="Password1", Structure:=False
The WorkSheet can be protected to allow changes from your code but not by your users.
This way you protect the WorkSheet and never have to unprotect it.
ActiveSheet.Protect Password:="Password2", UserInterfaceOnly:=True
In your code, you can set a boolean value to true if a test passes and exit the sub with a custom message if a test fails. Then test the boolean value and if it is true, unprotect the Workbook, make the update and reprotect the Workbook.
Option Explicit
Private Sub ProtectAll()
ActiveWorkbook.Protect Password:="Password1"
' ActiveWorkbook.Protect Password:="Password1", Structure:=False
'Optional: Allow changes to sheet names and order, not ideal
'but allows you to not have to protect and unprotect the workbook
ActiveSheet.Protect Password:="Password2", UserInterfaceOnly:=True
'Allow changes to the active worksheet by VBA code, remains protected via the UI
End Sub
Private Sub UnprotectAll()
ActiveSheet.Unprotect Password:="Password2"
ThisWorkbook.Unprotect Password:="Password1"
End Sub
Private Sub ProtectWB()
ActiveWorkbook.Protect Password:="Password1"
End Sub
Private Sub UnprotectWB()
ThisWorkbook.Unprotect Password:="Password1"
End Sub
Private Sub Change()
Dim CellValue As String
Dim OKtoChange As Boolean
Dim ErrorMessage As String
CellValue = vbNullString
OKtoChange = False
CellValue = ActiveSheet.Range("N41").Value
If Len(CellValue) < 32 Then
OKtoChange = True
Else
ErrorMessage = "The WorkSheet name is more than 31 characters."
GoTo ErrorHandler
End If
'Other tests here to set the OKtoChange variable based on results
'If any test fails the code exits
If OKtoChange = True Then
Call UnprotectWB
ActiveSheet.Name = CellValue
Call ProtectWB
End If
Exit Sub
ErrorHandler:
MsgBox "Invalid name for the WorkSheet" & vbLf & ErrorMessage, vbCritical, "Invalid name"
End Sub
I have a workbook with multiple sheets with an Activate sub and one sheet without, let's call it Sheet0. I want to, when switching from Sheet0 to any other sheet, check that some condition is met on Sheet0 before switching and stay on Sheet0 if the condition isn't met. I added a Deactivate sub in Sheet0 so that, when switching sheets, the condition is checked and if is not met, pops a message box and ends execution before the Activate sub from the other sheet runs.
Private Sub Worksheet_Deactivate()
If blnCondition Then
MsgBox ("[...]")
Me.Activate
End
End If
End Sub
I used the End statement but for some reason, it doesn't work as I thought it would. It ends execution of the Deactivate sub but still jumps to the other sheet's Activate sub, same as if I used an Exit Sub. My understanding of the End statement was that it was the ultimate stopping method in VBA.
Is my comprehension of the End statement wrong or am I missing something else?
Workbook SheetDeactivate Event
Workbook.SheetDeactivate Event
Copy the following code into the ThisWorkbook module. Sheet1 is the name of the worksheet that you don't want to deactivate if a condition is not met, in this example, if cell A1 is empty.
Option Explicit
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = "Sheet1" Then
If IsEmpty(Sh.Range("A1")) Then
Sh.Activate
Sh.Range("A1").Select
MsgBox "Cell 'A1' is empty.", vbCritical
End If
End If
End Sub
EDIT
To prevent triggering the Worksheet Activate events of the remaining worksheets you will need to use a global (public) variable that will indicate if it is safe to activate them i.e. the condition in e.g. Sheet1 is met. At the beginning of each of the Worksheet Activate event codes of the remaining worksheets, you will need to add an If statement checking for the value of the global variable.
Relevant Sheet Module, e.g. Sheet1 (code name, the name not in parentheses)
Option Explicit
Public IsNotMet As Boolean
Private Sub Worksheet_Deactivate()
If IsEmpty(Range("A1")) Then
IsNotMet = True
Me.Activate
Range("A1").Select
MsgBox "Cell 'A1' is empty.", vbCritical
Else
IsNotMet = False
End If
End Sub
All Other Sheet Modules
Option Explicit
Private Sub Worksheet_Activate()
If Sheet1.IsNotMet Then Exit Sub
' Your code, e.g.:
MsgBox "Worksheet '" & Me.Name & "' activated.", vbinformation
End Sub
The following code successfully changes the sheet name based on the value in cell "E26" i.e. if the value in "E26" is 'Test', sheet name will be named 'Test'.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Range("E26")
If Target = "" Then Exit Sub
Application.ActiveSheet.Name = VBA.Left(Target, 31)
Exit Sub
End Sub
Problem is, if I copy the sheet but want to keep the value in cell "E26" the same, the copied sheet name becomes "Test (1)" but I get a Run time error '1004': That name is already taken. Try a different one. obviously.
Question: How can I automatically add a number after each subsequent copy of the sheet i.e. Test (1), Test (2), etc. to avoid getting the error while still keeping the value in cell "E26" the same i.e. Test?
I don't know if I understood the idea, but try to count the current sheets in your book and concat to the name you want
Private Sub Worksheet_SelectionChange(ByVal Target As Range)`
Set Target = Range("E26")
Dim nSheets As Double
nSheets = ThisWorkbook.Sheets.Count
If Target = "" Then Exit Sub
'+1 is optional in order you have a secuence
Application.ActiveSheet.Name = Target & "(" & nSheets + 1 & ")"
End Sub
Let me suggest a bit more complex solution that hopefully also addesses all sort of end cases.
First, let's create a helper function that can answer the question "Is there a sheet with the name x?".
Function sheetExists(name) As Boolean
sheetExists = False
For i = 1 To Application.Worksheets.Count
shtName = Application.Worksheets(i).name
If shtName = name Then
sheetExists = True
Exit Function
End If
Next
End Function
Now that we have that option, let's build the actual code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
MaxTabs = 10 ' Adjust this number as needed.
BaseName = Range("E26").Value
If (BaseName = "") Then
Exit Sub
End If
name = BaseName
i = 0
For i = 1 To MaxTabs
If (Not sheetExists(name)) Then
Application.ActiveSheet.name = name
Exit Sub
End If
name = BaseName + " (" + Trim(Str(i)) + ")"
Next
End Sub
Worksheet Change
You could rather use the Worksheet_Change event and suppress the error(s) by using On Error.
The Code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range: Set rg = Intersect(Range("E26"), Target)
If Not rg Is Nothing Then
Application.EnableEvents = False
On Error GoTo clearError
Me.Name = Left(rg.Value, 31)
Application.EnableEvents = True
End If
Exit Sub
clearError:
'Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume Next
End Sub
I have a worksheet function that automatically calls CopyValues once dropdown in E4 changes on Sheet Debt Detail. This macro only runs if the sheet name is "Debt Detail" otherwise it is going to Exit Sub. This macro worked well until now. I added another sheet called "Borrower Statement", which is supposed to call BorrowerStatementCall if E4 changes in Sheet Borrower Statement.
I need to modify the existing Workbook function to accomplish this.
Below is the existing code. Any help and suggestions on how to accomplish this would be appreciated:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
If sh.Name <> "Debt Detail" Then Exit Sub
If Target.Address = Range("$E$4").Address Then
Call CopyValues
Range("A1").ClearOutline
Range("d2").Select
End If
Application.ScreenUpdating = True
End Sub
Some suggestions on your code:
Indent your code
Use at least some error handling if you're turning off screenupdating and other stuff
No need for the Call statement
Code:
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
On Error GoTo CleanFail
' Exit if modified cell is not E4
If Target.Address <> "$E$4" Then Exit Sub
' Turn off stuff to speed up process (only if modified cell is E4)
Application.ScreenUpdating = False
' Check the sheet name and call procedure accordingly
Select Case sh.Name
Case "Debt Detail"
' Do stuff if it's the target sheet
CopyValues ' Calls the sub CopyValues
sh.Range("A1").ClearOutline
sh.Range("D2").Select
Case "Borrower Statement"
' Do stuff if it's the target sheet
BorrowerStatementCall ' calls the sub BorrowerStatementCall
End Select
CleanExit:
' Turn on stuff again
Application.ScreenUpdating = True
Exit Sub
CleanFail:
MsgBox "An error occurred:" & Err.Description
GoTo CleanExit
End Sub
Let me know if it works
I am having trouble finding a way to capture any changes within a specific worksheet, within a specific pivot table.
The Pivot is "pivottable6"
The Worksheet is "APAC"
I have placed this code within the APAC worksheet module:
Private Sub Worksheet_PivotTableChange(ByVal Target As Excel.PivotTable6)
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Name & " on " & Sh.Name
End With
End Sub
But I keep getting an error. Any ideas on how to fix it?
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Target, Target As PivotTable)
If Intersect(Target, ActiveSheet.PivotTables(1)) Is Nothing Then Exit Sub
MsgBox ("cat")
End If
End Sub
this is still coming up with USER TYPE NOT DEFINED ERROR
Do you want to refresh the pivot when data in sheet changes ? If yes try below code :
Kindly place this code on the sheet which has the pivot.
Private Sub Worksheet_Calculate()
Sheets("APAC").PivotTables("pivottable6").RefreshTable
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Address & " on """ & Target.Parent.Name & """Sheet"
End With
Application.EnableEvents = True
End Sub
Your code makes use of Sh.Name, but Sh is not defined. Use Me.Name instead.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
With Target
MsgBox "You performed an operation in the following PivotTable: " & .Name & " on " & Me.Name
End With
End Sub
In answer to your other question, you need to change the IF statement to something like this:
Private Sub Workbook_SheetPivotTableChangeSync(ByVal Sh As Target, Target As PivotTable)
If Intersect(Target, ActiveSheet.PivotTables(1)) Is Nothing Then
Exit Sub
Else
MsgBox ("cat")
End If
End Sub