Automatically Run Excel Macros via Workbook & Worksheet Events
Got any Excel/VBA Questions? Free Excel Help
The code below shows you how you can use Excels Workbook Events to run your code when the Workbook opens, Activates, Deactivates, Closes and Saves. The quickest way to get to Excels Workbook Events is to right click on the sheet picture (top left next to "File") and select "View Code". Then choose an event from the "Procedure" drop down list box. For Excel 2000 you will need to select "Workbook" from the "Object" drop down list box first.
All examples must be placed within the Private Module of the Workbook Object "ThisWorkbook" as described above. Unless stated otherwise!
Hide all of Excels standard Menus and Toolbars and show only your Custom Toolbar.
This code will decide if the user has closed your Workbook or simply Activated another. This code (unless changed) assumes you have a Custom Toolbar called "MyToolBar" which is attached to the Workbook. Whenever the user closes or deactivates the Workbook, all Toolbars and Menubars will be restored as before.
To attach your a Custom Toolbar go to View>Toolbars>Customize-Attach then Copy your Custom Toolbar to the Workbook.
'Module level declaration
Dim IsClosed As Boolean, IsOpen As Boolean
Private Sub Workbook_Activate()
'Show the Custom toolbar
IsClosed = False
If IsOpen = False Then
Application.ScreenUpdating = False
Run "HideMenus"
Application.ScreenUpdating = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
IsClosed = True 'Closing so set to True
If Cancel = True Then IsClosed = False 'Changed their mind
End Sub
Private Sub Workbook_Deactivate()
Application.ScreenUpdating = False
IsOpen = False
On Error Resume Next 'In case it's already gone.
If IsClosed = True Then 'Workbook is closing.
With Application.CommandBars("MyToolBar")
.Protection = msoBarNoProtection
.Delete
End With
Run "ShowMenus"
Else 'They have only activated another Workbook
Run "ShowMenus"
End If
Application.ScreenUpdating = True
End Sub
The code below here must be placed within a Standard Module. It also assumes you have a hidden sheet with the CodeName of Sheet3.
'Module level declaration Dim Allbars As CommandBar Dim i As Integer, BarName As String Dim FormulaShow As Boolean Sub HideMenus() i = 0 Sheet3.Range("C1:C50").Clear On Error Resume Next For Each Allbars In Application.CommandBars If Allbars.Visible = True Then i = i + 1 With Sheet3 .Cells(i, 3) = Allbars.Name If Allbars.Name = "Worksheet Menu Bar" Then Allbars.Enabled = False Else Allbars.Visible = False End If End With End If Next Application.DisplayFormulaBar = False With Application.CommandBars("MyToolBar") .Visible = True .Position = msoBarTop .Left = 0 .Protection = msoBarNoMove End With On Error GoTo 0 End Sub Sub ShowMenus() On Error Resume Next With Sheet3 For i = 1 To WorksheetFunction.CountA(.Columns(3)) BarName = .Cells(i, 3)
Application.CommandBars(BarName).Enabled = True Application.CommandBars(BarName).Visible = True Next i i = 1 With Application.CommandBars("MyToolBar") .Protection = msoBarNoProtection .Visible = False End With Application.DisplayFormulaBar = True End With On Error GoTo 0 Application.CommandBars("Worksheet menu bar").Enabled = True End Sub
Prevent a user saving a Workbook as another name. That is, stop the Save as dialog box from showing.
Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then Cancel = True
End Sub
Automatic Pick From List Box.
This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code".
This is a work-around to the "Pick from list" option you get on the right click pop-up menu. The "Pick from list" option will only include Text entries, this code uses Validation to overcome this.
Option Explicit Dim strRange As String Private Sub Worksheet_BeforeRightClick _ (ByVal Target As Range, Cancel As Boolean) If Target.Row = 1 Then Exit Sub If Target.Cells.Count > 1 Then Exit Sub 'Parse a range address containing all cells above active cell strRange = Target.EntireColumn.Cells(1, 1).Address & _ ":" & Target.Offset(-1, 0).Address 'Add some validation using the "List" option _ and our variable strRange as the range for the list. With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop _ , Operator:=xlBetween, Formula1:="=" & strRange .IgnoreBlank = True .InCellDropdown = True .ShowInput = False .ShowError = False End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Remove all validation in the Column If strRange <> vbNullString Then _ Range(strRange).EntireColumn.Validation.Delete strRange = vbNullString End Sub
Download Workbook Example of This
Automatic Highlighting of Active Row
This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code".
Here is a handy little bit of code that will highlight the current row as you select it. But only if the row is NOT empty.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim strRow As String
Cells.FormatConditions.Delete
With Target.EntireRow
strRow = .Address
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, _
Formula1:="=COUNTA(" & strRow & ")>0"
.FormatConditions(1).Font.Bold = True
.FormatConditions(1).Interior.ColorIndex = 15
End With
End Sub
Perform Some Action When the User Exits a Nominated Cell
This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code".
This Procedure will fire automatically when a user exits cell A1 (can be any cell). Note the Dimensioning (Dim) of the Variable "rTriggerCell" is at the Procedure Level.
Dim rTriggerCell As Range Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Triggers an action upon user exiting cell A1 On Error Resume Next Application.EnableEvents = False 'Entered into Trigger cell If Target.Address = "$A$1" Then Set rTriggerCell = Target Application.EnableEvents = True On Error GoTo 0 Exit Sub End If If Not rTriggerCell Is Nothing Then 'They are leaving A1 MsgBox "You just left cell A1", vbInformation, "OzGrid.com" Set rTriggerCell = Nothing End If Application.EnableEvents = True On Error GoTo 0 End Sub
Have a Cell Ticked Upon Selection
This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code".
This code is an alternative to Checkboxes and can save a lot of space and is much easier to count the ticks! Just use the COUNTIF Function. This code works on only range A1:A10, but can be modified to suit. It could also be used in the Before Double Click event.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub
Getting past Conditional Formattings 3 Criteria Limit
This code must be placed in the Private Module of the Worksheet. To get there right click on the sheet name tab and select "View Code".
Excel's very handy Conditional Formatting unfortunately only allows up to 3 conditions. The method below gets around this limit. It is set to work on A1:A10 only.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("A1:A10")) is Nothing Then
Select Case Target
Case 1 To 5
icolor = 6
Case 6 To 10
icolor = 12
Case 11 To 15
icolor = 7
Case 16 To 20
icolor = 53
Case 21 To 25
icolor = 15
Case 26 To 30
icolor = 42
Case Else
'Whatever
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub
Creating A UserForm Splash Screen
Right click on the Excel icon, top left next to "File", select "View Code" and paste in this Code.
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:15"), "HideSplash"
UserForm1.Show
End Sub
Now in any Standard Module place this code
Sub HideSplash() Unload UserForm1 End Sub
See also:
See also: Index to Excel VBA Code; Index to Excel Freebies; Lesson 1 - Excel Fundamentals; Index to how to… providing a range of solutions
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions. Geneve
Gallery
