Ryan
Ryan

Reputation: 1

Microsoft VBA - How to run different code depending on the current date in relation to set date ranges

Basically I'm trying to run 4 sets of code, each set depending on what quarter of the year it is i.e. if the current date is between 1/1 - 3/31 then run xx code, if the current date is between 4/1 - 6/30 then run yy code and so on etc.

Is there a way to set that up within the actual code and not using Excel? As you can probably tell, I'm not an expert by any means and have picked up most of what I know from trial and error and browsing here/google. I've searched around quite a bit but can't find this specific topic so any help is appreciated.

Thanks!

    Sub QuarterlyCheck ()

    DateToday = Date$
  
    Dim EditedDate As String
    EditedDate = DateAdd("d", 0, DateToday)
    Dim EditedDate2 As String
    EditedDate2 = Replace(EditedDate, "/", "-")
    EditedDate3 = Format(EditedDate2, "mm-dd-yyyy")

    If EditedDate3 is >= 1/1/2021 and <= 3/31/2021 then
        Do this...

    Else If EditedDate3 is >= 4/1/2021 and <= 6/30/2021 then
        Do this...

    Else If EditedDate3 is >= 7/1/2021 and <= 9/30/2021 then
        Do this...

    Else If EditedDate3 is >= 10/1/2021 and <= 12/31/2021 then
        Do this...

    EndIf

    End Sub

Upvotes: 0

Views: 44

Answers (2)

Ben Mega
Ben Mega

Reputation: 522

I think you are looking for something like this. Thank you Raymond Wu for the reminder about the Select Case option for a more eloquent solution.

    Sub QuarterlyCheck()
        
        Select Case Format(Date$, "q")
            Case 1
                MsgBox "Quarter 1 Code here"
            Case 2
                MsgBox "Quarter 2 Code here"
            Case 3
                MsgBox "Quarter 3 Code here"
            Case 4
                MsgBox "Quarter 4 Code here"
        End Select

    End Sub

Just replace the message boxes with the code you want to run each quarter.

Upvotes: 1

Raymond Wu
Raymond Wu

Reputation: 3387

You can use Select statement to do the check:

Sub QuarterlyCheck()
    
    Dim todayYear As Long
    todayYear = Year(Date)
    
    Select Case True
        Case (Date >= DateSerial(todayYear, 1, 1) And Date <= DateSerial(todayYear, 3, 31))
            'Do things for 1st Quarter
        Case (Date >= DateSerial(todayYear, 4, 1) And Date <= DateSerial(todayYear, 6, 30))
            'Do things for 2nd Quarter
        Case (Date >= DateSerial(todayYear, 7, 1) And Date <= DateSerial(todayYear, 9, 30))
            'Do things for 3rd Quarter
        Case Else
            'Do things for 4th Quarter
    End Select
End Sub

Upvotes: 1

Related Questions