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.