Automatically Run Excel Macros via Workbook & Worksheet Events

NEW! More Books..

Add Excel Answers & Search To Your Google Toolbar Details

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only ~~$145.00~~. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Back to: Excel VBA . Got any Excel/VBA Questions? Free Excel Help

Hide & Restore Excel's Native Toolbars. See Also: Hide/Restore Excel Toolbars

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

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft