Derive Quarters

[khwaja]

Thanks for the prompt response. Kindly have a look on the second para of my earlier post which I edited after you responded.

 

[namliam]

QFix = "FY " & Right(Year(DateAdd("M", 6, BuilderComp)), 2) & " Qtr " & AutoQ

QFix = "FY " & Right(Year(DateAdd("M", 6, BuilderComp)), 2) & " Qtr " & AutoQ

Odd that these two lines are the same, that obviously is wrong

Would this fix your issue(s)

Public Function QFix(BuilderComp As Date) As String 'To work out quarters

    Dim StartQ As Date
    Dim EndQ As Date
    Dim AutoQ As Integer
    AutoQ = Format(DateAdd("m", -6, BuilderComp), "Q")
    If BuilderComp < DateSerial(Year(BuilderComp), 7, 1) Then
        StartQ = DateAdd("q", AutoQ - 1, DateSerial(Year(BuilderComp) - 1, 7, 1))
        EndQ = DateAdd("Q", AutoQ, DateSerial(Year(BuilderComp) - 1, 7, 1)) - 1
    Else
        StartQ = DateAdd("q", AutoQ - 1, DateSerial(Year(BuilderComp), 7, 1))
        EndQ = DateAdd("Q", AutoQ, DateSerial(Year(BuilderComp), 7, 1)) - 1
    End If
    
    ' Make the monday before be the start
    StartQ = StartQ - Weekday(StartQ, vbMonday) + 1
    EndQ = EndQ - Weekday(EndQ, vbMonday)
    
    If BuilderComp > EndQ Then
        ' last days of any quarter, move it back one quarter
        AutoQ = Format(DateAdd("m", -3, BuilderComp), "Q")
        QFix = "FY " & Right(Year(DateAdd("M", 9, BuilderComp)), 2) & " Qtr " & AutoQ
    Else
        ' normal quarter
        QFix = "FY " & Right(Year(DateAdd("M", 6, BuilderComp)), 2) & " Qtr " & AutoQ
    End If
End Function

 

[khwaja]

So very grateful for the help. It works great.