Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

Automatically Run Excel Macros via Workbook & Worksheet Events

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 Become an ExcelUser Affiliate & Earn Money

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 [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

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