Select Case Structure
Select Case is a good alternative to the IF Then Else structure when you have lots of possible options. The structure of Select Case is as follows:
Select Case TestExpression Case Condition Set of instructions Case Condition Set of instructions Case Condition Set of instructions Case Condition Set of instructions Case Else Default set of instruction End Select
In English the Select Case structure might read like this.
Select Case WhatToPaint Case Sky PaintColour = Blue Case Grass PaintColour = Green Case Cloud PaintColour = Grey Case Else PaintColour = Orange End Select
The instructions tell you paint the sky blue, the grass green, clouds grey and everything else orange. A bit of a strange painting but you get the idea!
Select Case vs IF Then Else
See below for a comparison of Select Case and IF Then Else. The two procedures do exactly the same thing.
IF Then Else Version
Sub IfVsSelectCase_IFVersion() Dim rg As Range, SalesFigures As Range, Bonus As Range Set SalesFigures = Range("B2", Range("B2").End(xlDown)) For Each rg In SalesFigures Set Bonus = rg.Offset(0, 1) Bonus.NumberFormat = "£#,##0" If rg >= 30000 Then Bonus = 400 ElseIf rg >= 25000 Then Bonus = 300 ElseIf rg >= 20000 Then Bonus = 250 ElseIf rg >= 15000 Then Bonus = 200 ElseIf rg >= 10000 Then Bonus = 150 Else: Bonus = 0 End If Next rg End Sub
Select Case Version
Sub IfVsSelectCase_SelectCaseVersion() Dim rg As Range, SalesFigures As Range, Bonus As Range Set SalesFigures = Range("B2", Range("B2").End(xlDown)) For Each rg In SalesFigures Set Bonus = rg.Offset(0, 1) Bonus.NumberFormat = "£#,##0" Select Case rg Case Is >= 30000 Bonus = 400 Case Is >= 25000 Bonus = 300 Case Is >= 20000 Bonus = 250 Case Is >= 15000 Bonus = 200 Case Is >= 10000 Bonus = 150 Case Else Bonus = 0 End Select Next rg End Sub
The two example procedures relate to the data shown below.
Select Case Examples
Welcome Message Example
This procedure shows a welcome message to the user in the both Excel’s status bar and Excel’s caption (Excel’ title bar). The procedure is run automatically when the workbook is opened.
Private Sub Workbook_Open() Dim UserName As String UserName = Application.UserName Select Case Time Case Is < 0.5 With Application .StatusBar = "Good Morning " & UserName _ & ". You opened this file at " & Time .Caption = "Good Morning " & UserName _ & ". You opened this file at " & Time End With Case 0.5 To 0.75 With Application .StatusBar = "Good Afternoon " & UserName _ & ". You opened this file at " & Time .Caption = "Good Afternoon " & UserName _ & ". You opened this file at " & Time End With Case Is > 0.75 With Application .StatusBar = "Good Evening " & UserName _ & ". You opened this file at " & Time .Caption = "Good Evening " & UserName _ & ". You opened this file at " & Time End With End Select End Sub
OverDue Invoice Fee Example
This procedure calculates the overdue fee for invoices. The case criteria uses comparison operators. You must use the keyword Is wth a comparison operator.
Sub OverDueInvoiceStatusAndFee() Const FeePercentage As Single = 0.0025 Dim DateDue As Range, DateDueField As Range, _ Status As Range, Fee As Range, InvAmt As Range Set DateDueField = Range("C1", Range("C1").End(xlDown)) For Each DateDue In DateDueField 'locate all the values for the overdue fee calculation Set Status = DateDue.Offset(0, 1) Set Fee = DateDue.Offset(0, 2) Set InvAmt = DateDue.Offset(0, -1) Fee.NumberFormat = "£#,##0.00" Select Case DateDue 'if invoice overdue... Case Is < Date Status = "Overdue" Status.Interior.Color = vbRed Fee = InvAmt * FeePercentage * (Date - DateDue) 'if invoice is not yet due... Case Is > Date Status = "OK" 'if invoice is due today... Case Is = Date Status = "Due Today" Status.Interior.Color = vbYellow End Select Next DateDue End Sub
The procedure above relates to the data shown below.
Student Grades Example
This procedure grades students based on their exam mark. In this example the case criteria expresses a range of values. You will also notice that you can put the criteria and instructions on the same line. Separate the criteria from the instructions with a colon.
Sub StudentGrades() Dim StudentMark As Range, StudentMarkField As Range, Grade As Range Set StudentMarkField = Range("B2", Range("B2").End(xlDown)) For Each StudentMark In StudentMarkField Set Grade = StudentMark.Offset(0, 1) Select Case StudentMark Case 0 To 9: Grade = "G" Case 10 To 24: Grade = "F" Case 25 To 34: Grade = "E" Case 35 To 49: Grade = "D" Case 50 To 64: Grade = "C" Case 65 To 79: Grade = "B" Case 80 To 89: Grade = "A" Case 90 To 100: Grade = "A*" End Select Next StudentMark End Sub
The code above relates to the date shown below.
Format Based on Data Type Example
This example format cells based on data type. The case expression is TRUE. Each case criteria uses a function that returns TRUE or FALSE.
Sub FormatCellsBasedonDataType() Dim rg As Range Dim list As Range Set list = Range("A1:A8") For Each rg In list Select Case True Case Is = WorksheetFunction.IsError(rg) rg.Interior.Color = vbCyan Case Is = IsEmpty(rg) rg.Interior.Color = vbBlack Case Is = WorksheetFunction.IsFormula(rg) rg.Interior.Color = vbRed rg.Font.Color = vbWhite Case Is = WorksheetFunction.IsText(rg) rg.Interior.Color = vbGreen Case Is = WorksheetFunction.IsNumber(rg) rg.Interior.Color = vbYellow Case Is = WorksheetFunction.IsLogical(rg) rg.Interior.Color = vbBlue rg.Font.Color = vbWhite End Select Next rg End Sub
The code above relates to the data displayed below.
Assign Branch to Region Example
This procedure assigns a region to each branch in a database. Notice how you can list several values for each case criteria.
Sub AssignToRegion() Dim Branch As Range, BranchField As Range, Region As Range Set BranchField = Range("B2", Range("B2").End(xlDown)) For Each Branch In BranchField Set Region = Branch.Offset(0, 4) Select Case Branch Case Is = "Brighton", "London", "Southampton" Region = "SOUTH" Case Is = "Nottingham", "Wolverhampton", "Leicester", "Birmingham" Region = "MIDLANDS" Case Is = "Aberdeen", "Edinburgh" Region = "SCOTLAND" Case Is = "Cardiff", "Swansea" Region = "WALES" Case Is = "Sheffield", "Newcastle upon Tyne" Region = "NORTH" Case Is = "Belfast" Region = "IRELAND" End Select Next Branch End Sub
The code above relates to the example below.
Nested Select Case Example
This procedure calculates a discounted total. The discount percentage is different for each product category but also depends on qty purchased. The procedure employs a nested Select Case structure. Within each Select Case for product category there is nested Select Case for Qty which returns the correct discount percentage.
Sub NestedSelectCase() Dim Category As Range, CategoryField As Range, Qty As Range, Price As Range, _ DiscountedTotal As Range Dim DiscountPercent As Single Set CategoryField = Range("G2", Range("G2").End(xlDown)) For Each Category In CategoryField Set Qty = Category.Offset(0, 1) Set Price = Category.Offset(0, 2) Set DiscountedTotal = Category.Offset(0, 3) DiscountedTotal.NumberFormat = "£#,##0.00" Select Case Category Case "A" Select Case Qty Case 0 To 9: DiscountPercent = 0 Case 10 To 24: DiscountPercent = 0.02 Case 25 To 99: DiscountPercent = 0.05 Case Is >= 100: DiscountPercent = 0.08 End Select DiscountedTotal = Qty * Price * (1 - DiscountPercent) Case "B" Select Case Qty Case 0 To 9: DiscountPercent = 0 Case 10 To 24: DiscountPercent = 0.05 Case 25 To 49: DiscountPercent = 0.08 Case 50 To 99: DiscountPercent = 0.1 Case Is >= 100: DiscountPercent = 0.15 End Select DiscountedTotal = Qty * Price * (1 - DiscountPercent) Case "C" Select Case Qty Case 0 To 9: DiscountPercent = 0 Case 10 To 24: DiscountPercent = 0 Case 25 To 49: DiscountPercent = 0.05 Case 50 To 99: DiscountPercent = 0.07 Case Is >= 100: DiscountPercent = 0.1 End Select DiscountedTotal = Qty * Price * (1 - DiscountPercent) End Select Next Category End Sub
The code above relates to the data shown below.