How do I add 2 conditions (cell value and date range) in VB scrip Select Case?

Question

I tried this simple script:

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Range("B16").Value
             Case ""
                  Range("A23").Value = ""
             Case "Inbound"
                  Range("A23").Value = ""
             Case "Outbound"
                  Range("A23").Value = "Surcharge"
        End Select
End Sub

I need to insert a date range. The date is in cell D16. If this date is between 15may2021 and 31oct2021 the combination of this date range and

Case "Outbound"

would return:

Range("A23").Value = "Surcharge"

How can I achieve this?

thanks, IR

Answer 1

Before I answer your question, this

Case ""
     Range("A23").Value = ""
Case "Inbound"
     Range("A23").Value = ""

can also be written as

Case "", "Inbound"
    Range("A23").Value = ""

Now, declare this at the top

Dim StartDate As Date
Dim EndDate As Date
Dim curdate As Date

and then use

StartDate = DateSerial(2021, 5, 15)
EndDate = DateSerial(2021, 10, 31)

Select Case Range("B16").Value
Case "", "Inbound"
    Range("A23").Value = ""    
Case "Outbound"
    curdate = Range("D16").Value
    
    If curdate >= StartDate And curdate <= EndDate Then
        Range("A23").Value = "Surcharge"
    End If
End Select

I am assuming that D16 has a valid date. Also since you are working with Worksheet_Change, you may want to readup on things to be careful about when using Worksheet_Change

NOTE: To make the Select Case more robust you can also use

Select Case UCase(Trim(Range("B16").Value))
Case "", "INBOUND"
      
Case "OUTBOUND"

End Select

This will ensure the check is not case sensitive and also if the cell appears to be empty but has spaces. Of course, this doesnt take into consideration the unprintable characters.

Answer 2

A Worksheet Change

• Note that you need to monitor two cells (Source Cell and Criteria Cell).
• Study the various possibilities and modify the occurrences of dCell.Value = "" to fit your needs.
• Uncomment the out-commented Debug.Print lines to better understand how it works.
• It was not working correctly so I had to take Siddharth Rout's advice (follow the link in his answer) and disable events (with error handling).

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const sAddress As String = "D16" ' Source Cell
    Const cAddress As String = "B16" ' Criteria Cell
    Const dAddress As String = "A23" ' Destination Cell
    Const fDate As String = "05/15/2021" ' First Date
    Const lDate As String = "10/31/2021" ' Last Date
     
    Dim sCell As Range: Set sCell = Range(sAddress)
    Dim cCell As Range: Set cCell = Range(cAddress)
    Dim dCell As Range: Set dCell = Range(dAddress)
    
    If Not Intersect(sCell, Target) Is Nothing _
            Or Not Intersect(cCell, Target) Is Nothing Then
        'Debug.Print "Intersecting..."
        On Error GoTo clearError
        Application.EnableEvents = False
        If VarType(sCell.Value) = vbDate Then
            'Debug.Print "It's a date."
            Dim cValue As Variant: cValue = CLng(sCell.Value)
            Dim fValue As Long: fValue = CLng(DateValue(fDate))
            Dim lValue As Long: lValue = CLng(DateValue(lDate))
            'Debug.Print cValue, fValue, lValue
            If cValue >= fValue And cValue <= lValue Then
                Debug.Print "In date range."
                Select Case CStr(cCell.Value)
                Case ""
                    dCell.Value = ""
                Case "Inbound"
                    dCell.Value = ""
                Case "Outbound"
                    dCell.Value = "Surcharge"
                Case Else
                    ' Neither "", "Inbound" or "Outbound"
                    dCell.Value = ""
                End Select
            Else
                Debug.Print "Not in date range."
                dCell.Value = ""
            End If
        Else
            'Debug.Print "Not a date"
            dCell.Value = ""
        End If
SafeExit:
        Application.EnableEvents = True
    Else
        'Debug.Print "Cell values not changed (No intersection)."
    End If

    Exit Sub

clearError:
    Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
    Resume SafeExit

End Sub