[AccessD] Dates From Previous Month

John W. Colby jwcolby at colbyconsulting.com
Tue Jun 7 11:05:54 CDT 2005


Private Function dateStartRange(intRangeOption As Integer) As Date
On Error GoTo Err_dateStartRange
'Julie Schwalm, Backroads Data, 1999
'Input: interger value of option group containing standard date ranges,
'such as Current Month, Year-to-Date, Last Quarter, etc.  Values equal:
'   1 = Include all Dates
'   2 = Current Month
'   3 = Current Quarter
'   4 = Current Year
'   5 = Month-to-Date
'   6 = Quarter-to-Date
'   7 = Year-to-Date
'   8 = Last Month
'   9 = Last Quarter
'  10 = Last Year
'  11 = Last 12 months
'  12 = Custom Date
'OUTPUT: Date to be placed in unbound text box, representing the beginning
'of the date range for the selected report.
    Dim dateResult As Date
    
    Select Case intRangeOption
        Case 1  'Include all Dates
            Let dateResult = #1/1/1900#
        Case 2, 5   'Current Month
            Let dateResult = DateSerial(Year(Date), Month(Date), 1)
        Case 3, 6
            Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 1, 1)
        Case 4, 7
            Let dateResult = DateSerial(Year(Date), 1, 1)
        Case 8
            Let dateResult = DateSerial(Year(Date), Month(Date) - 1, 1)
        Case 9
            Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 1 - 3, 1)
        Case 10
            Let dateResult = DateSerial(Year(Date) - 1, 1, 1)
        Case 11
            Let dateResult = DateAdd("yyyy", -1, Date) + 1
    End Select
    
    dateStartRange = Format(dateResult, "mm\/dd\/yyyy")
    
Exit_dateStartRange:
Exit Function
Err_dateStartRange:
    Select Case Err
    Case 0      '.insert Errors you wish to ignore here
        Resume Next
    Case Else   '.All other errors will trap
        Beep
        MsgBox Err.Description, , "Error in Function
basDateFunctions.dateStartRange"
        Resume Exit_dateStartRange
    End Select
    Resume 0    '.FOR TROUBLESHOOTING
End Function
Private Function dateEndRange(intRangeOption As Integer) As Date
On Error GoTo Err_dateEndRange
'Julie Schwalm, Backroads Data, 1999
'Input: interger value of option group containing standard date ranges,
'such as Current Month, Year-to-Date, Last Quarter, etc.  Values equal:
'   1 = Include all Dates
'   2 = Current Month
'   3 = Current Quarter
'   4 = Current Year
'   5 = Month-to-Date
'   6 = Quarter-to-Date
'   7 = Year-to-Date
'   8 = Last Month
'   9 = Last Quarter
'  10 = Last Year
'  11 = Last 12 months
'  12 = Custom Date
'OUTPUT: Date to be placed in unbound text box, representing the end
'of the date range for the selected report.
    Dim dateResult As Date
    Dim strDate As Date
    
    Select Case intRangeOption
        Case 1
            Let dateResult = #1/1/2115#
        Case 2
            Let dateResult = DateSerial(Year(Date), Month(Date) + 1, 0)
        Case 3
            Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 4, 0)
        Case 4
            Let dateResult = DateSerial(Year(Date), 12, 31)
        Case 5, 6, 7, 11
            Let dateResult = Date
        Case 8
            Let dateResult = DateSerial(Year(Date), Month(Date), 0)
        Case 9
            Let dateResult = DateSerial(Year(Date), Int((Month(Date) - 1) /
3) * 3 + 4 - 3, 0)
        Case 10
'            Let dateResult = DateAdd("yyyy", -1, Date) + 1
            Let dateResult = DateSerial(Year(Date) - 1, 12, 31)
    End Select
    
    dateEndRange = Format(dateResult, "mm\/dd\/yyyy")
    
Exit_dateEndRange:
Exit Function
Err_dateEndRange:
    Select Case Err
    Case 0      '.insert Errors you wish to ignore here
        Resume Next
    Case Else   '.All other errors will trap
        Beep
        MsgBox Err.Description, , "Error in Function
basDateFunctions.dateEndRange"
        Resume Exit_dateEndRange
    End Select
    Resume 0    '.FOR TROUBLESHOOTING
End Function

John W. Colby
www.ColbyConsulting.com 

Contribute your unused CPU cycles to a good cause:
http://folding.stanford.edu/

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Mark Boyd
Sent: Tuesday, June 07, 2005 11:49 AM
To: Access Developers discussion and problem solving
Subject: [AccessD] Dates From Previous Month


I'm looking for a way to get the 1st and last dates from the previous month.
I'm working on an invoicing app, and need to determine the previous months
date range.  Is there a function, or use of the Format statement that will
give me this info?
 
Thanks,
Mark Boyd
I/S Supervisor
McBee Associates, Inc.
 
-----------------------------------------
This message and any attachments are intended only for the use of the
individual or entity to which it is addressed and may contain information
that is privileged, confidential, and exempt from disclosure under
applicable law. If the reader of this message is not the intended recipient,
or the employee or agent responsible for delivering the message to the
intended recipient, you are hereby notified that any dissemination,
distribution or copying of this communication is strictly prohibited. If you
have received this communication in error, please notify the sender by
replying to this message, and then delete it from your system.
-------------------------------------------
-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com






More information about the AccessD mailing list