Skip to content

Excel VBA – Select Case Structure (7 Example Macros)

    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.