Report - Select Case

[DomFino]

I managed to use the code from D. Hookom on thread 703-896152, but am wondering if anyone knows what the function Get quarter may look like. I suspect he created a function that interprets the GetQtrStart and End dates but am not sure of how to recreate one.

Private Sub lboDates_AfterUpdate()
  '============================================================
  '     Purpose:
  '   Copyright: Copyright 2003
  '  Programmer: Duane Hookom
  ' Called From:
  '        Date: 3/31/2003
  '  Parameters:
  '============================================================
    On Error GoTo lboDates_AfterUpdate_Err
    Dim strErrMsg As String 'For Error Handling

    Select Case Me.lboDates
        Case "Clear"
            Me.txtFromDate = Null
            Me.txtToDate = Null
        Case "This Yr"
            Me.txtFromDate = DateSerial(Year(Date), 1, 1)
            Me.txtToDate = DateSerial(Year(Date), 12, 31)
        [COLOR=red]Case "This Qtr"
            Me.txtFromDate = GetQtrStart(Date)
            Me.txtToDate = GetQtrEnd(Date)[/color]
        Case "This Mth"
            Me.txtFromDate = DateSerial(Year(Date), Month(Date), 1)
            Me.txtToDate = DateSerial(Year(Date), Month(Date) + 1, 0)
        Case "This Wk"
            Me.txtFromDate = DateAdd("d", -WeekDay(Date) + 1, Date)
            Me.txtToDate = DateAdd("d", 6, Me.txtFromDate)
        Case "Last Yr"
            Me.txtFromDate = DateSerial(Year(Date) - 1, 1, 1)
            Me.txtToDate = DateSerial(Year(Date) - 1, 12, 31)
        [COLOR=red]Case "Last Qtr"
            Me.txtFromDate = GetQtrStart(DateAdd("m", -3, Date))
            Me.txtToDate = GetQtrEnd(DateAdd("m", -3, Date))[/color]
        Case "Last Mth"
            Me.txtFromDate = DateSerial(Year(Date), Month(Date) - 1, 1)
            Me.txtToDate = DateSerial(Year(Date), Month(Date), 0)
        Case "Last Wk"
            Me.txtFromDate = DateAdd("d", -WeekDay(Date) + 1, Date) - 7
            Me.txtToDate = DateAdd("d", 6, Me.txtFromDate)

    End Select
            

lboDates_AfterUpdate_Exit:
    On Error Resume Next
    Exit Sub

lboDates_AfterUpdate_Err:
    Select Case Err
        Case Else
            strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            strErrMsg = strErrMsg & "Error Description: " & Err.Description
            MsgBox strErrMsg, vbInformation, "lboDates_AfterUpdate"
            Resume lboDates_AfterUpdate_Exit
    End Select
End Sub

 

[dhookom]

Try these:

Function GetQuarterStart(pdatDate As Date) As Date
    Dim intQtr As Integer
    intQtr = (Month(pdatDate) - 1) \ 3 + 1
    GetQuarterStart = DateSerial(Year(pdatDate), 3 * (intQtr - 1) + 1, 1)
End Function
Function GetQuarterEnd(pdatDate As Date) As Date
    GetQuarterEnd = DateAdd("q", 1, GetQuarterStart(pdatDate)) - 1
End Function

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]

 

[DomFino]

Duane.
Thank you so much for the quick reply. This is a nice piece of code that I can use over and over again.
Again, Thanks.
Dom

 

[NotSoSmartUser]

Can't download the DH_QBF.zip sample from hookom website, can anyone help pls ?

http://www.access.hookom.net/samples/

 

[dhookom]

The download is also available at

http://www.rogersaccesslibrary.com/OtherLibraries.asp#Hookom,Duane.

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]