CODEWITHSUNDEEP
vbaexceldateexcel-2010
Jack Henderson
Jack Henderson

Reputation: 93

Excel VBA: Date Comparison

So I'm currently trying to make a code to compare the current date to two other dates in order to determine the validity of information. For example, if the date is between the first quarter of the year and the second quarter, the information on the document is as of the first quarter date (March 31). Below is what I currently have and for some reason even though the current date is in July, the code keeps saying the information is valid as of March 31. Anyone have any suggestions?

crntDate = Date
q1End = CDate("Mar 31" & " " & Year(Date))
q2End = CDate("Jun 30" & " " & Year(Date))
q3End = CDate("Sep 30" & " " & Year(Date))
q4End = CDate("Dec 31" & " " & Year(Date))

If q1End <= crntDate <= q2End Then
    quart = "Q1" & " " & Year(Date)
ElseIf q2End <= crntDate <= q3End Then
    quart = "Q2" & " " & Year(Date)
ElseIf q3End <= crntDate <= q4End Then
    quart = "Q3" & " " & Year(Date)
Else
    quart = "Q4" & " " & Year(Date)
End If

shName = "Quarterly Reporting for" & " " & firstName & " " & lastName & " " & "(" & quart & ")"
With wdApp.ActiveDocument
    .SaveAs2 "https://path/" & shName & ".docx"
    .Close
End With

Upvotes: 1

Views: 2299

Answers (2)

ThunderFrame
ThunderFrame

Reputation: 9461

If you're trying to format dates as quarters, you don't need all of the end dates and comparisons, you can just use integer division \ in VBA.

Sub test()

  Dim quart As String
  quart = GetDateAsQuarterYear(VBA.Date)

  shName = "Quarterly Reporting for" & " " & firstName & " " & lastName & " " & "(" & quart & ")"
  With wdApp.ActiveDocument
    .SaveAs2 "https://path/" & shName & ".docx"
    .Close
  End With
End Sub

Function GetDateAsQuarterYear(crntDate As Date) As String

  Dim quarterEnd As Date
  quarterEnd = DateSerial(Year(crntDate), 1 + 3 * (1 + (Month(crntDate) - 1) \ 3), 0)

  GetDateAsQuarterYear = "Q" & 1 + (Month(crntDate) - 1) \ 3 & " (" & Format$(quarterEnd, "mmmm d, yyyy") & ")"

End Function

Upvotes: 3

Scott Craner
Scott Craner

Reputation: 152450

q1End <= crntDate <= q2End does not work in Excel it needs to be:

q1End <= crntDate  and crntDate <= q2End

So

crntDate = Date
q1End = CDate("Mar 31" & " " & Year(Date))
q2End = CDate("Jun 30" & " " & Year(Date))
q3End = CDate("Sep 30" & " " & Year(Date))
q4End = CDate("Dec 31" & " " & Year(Date))

If q1End <= crntDate  and crntDate <= q2End Then
    quart = "Q2" & " " & Year(Date)
ElseIf q2End <= crntDate  and crntDate <= q3End Then
    quart = "Q3" & " " & Year(Date)
ElseIf q3End <= crntDate  and crntDate <= q4End Then
    quart = "Q4" & " " & Year(Date)
Else
    quart = "Q1" & " " & Year(Date)
End If

shName = "Quarterly Reporting for" & " " & firstName & " " & lastName & " " & "(" & quart & ")"
With wdApp.ActiveDocument
    .SaveAs2 "https://path/" & shName & ".docx"
    .Close
End With

Upvotes: 2

Related Questions