VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



Advanced Begin & End Date Calculations Simplified

by Chad M. Kovac (4 Submissions)
Category: Microsoft Office Apps/VBA
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: (2 Votes)

Allows calculation of Begin or End dates based upon the RANGE (Week, Month, Year), the DATE to use as the source or comparison date and PREV or CURRENT range. Examples:
'BeginDateCalc("W","P",#11/15/2000#) returns: 11/5/00 as the first day or the PREVIOUS WEEK is Sunday the 5th. You could easily modify the code to allow the last day of the week to be any day you wish.
'BeginDateCalc("M","P",#11/15/2000#) = 10/1/00
'BeginDateCalc("M","C",#11/15/2000#) = 11/1/00
'BeginDateCalc("Wm","C",#11/15/2000#) = 11/1/00 'Wm is used to tell us Week but Month limited. 'Notice the same with "W" instead of "Wm" would result in 10/29/00

Inputs
Range, Calculation, Date
Assumes
'Public Domain: This code may be used and distributed freely as long as header remains unchanged. 'The person(s) supplying this code can not be held liable for use, misuse or damage caused by the use of this code. 'Written by Chad M. Kovac 'CEO, Tech Knowledgey, Inc. '[email protected] 'http://www.TechKnowledgeyInc.com '10/04/00 MS Access 97/2000
Code Returns
Caculated Date
API Declarations
Created for use in VBA with MS Access.

Rate Advanced Begin & End Date Calculations Simplified

Function EndDateCalc(Range As String, Prev_or_Current As String, Optional FDate As Date) As Date
On Error GoTo Errored
GoTo Main
Errored:
Call Errored_Out(Err.Source, Err.Number, Err.Description, False)
Main:
If FDate <= #1/1/1900# Then FDate = Now()
On Error Resume Next
Reselect:
Select Case Prev_or_Current
Case "P"
 Select Case Range
 Case "D"
 EndDateCalc = DateValue(Format(FDate, "mm/dd/yyyy"))
 Case "W"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w")), "mm/dd/yyyy"))
 Case "Wm"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w")), "mm/dd/yyyy"))
 If Format(EndDateCalc, "yyyymm") > Format(FDate, "yyyymm") Then
 Range = "M"
 GoTo Reselect
 End If
 Case "M"
 Err.Clear
 EndDateCalc = DateValue(Format(FDate - (Val(Format(FDate, "dd"))), "mm/31/yyyy"))
 If Err.Number > 0 Then
 Err.Clear
 EndDateCalc = DateValue(Format(FDate - (Val(Format(FDate, "dd"))), "mm/30/yyyy"))
 If Err.Number > 0 Then
 Err.Clear
 EndDateCalc = DateValue(Format(FDate - (Val(Format(FDate, "dd"))), "mm/29/yyyy"))
 If Err.Number > 0 Then
 Err.Clear
 EndDateCalc = DateValue(Format(FDate - (Val(Format(FDate, "dd"))), "mm/28/yyyy"))
 If Err.Number > 0 Then EndDateCalc = #1/1/90#
 End If
 End If
 End If
  
End Select
Case "C"
 Select Case Range
 Case "D"
 EndDateCalc = DateValue(Format(FDate, "mm/dd/yyyy"))
 Case "W"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 7), "mm/dd/yyyy"))
 Case "Wm"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 7), "mm/dd/yyyy"))
 If Format(EndDateCalc, "yyyymm") > Format(FDate, "yyyymm") Then
 Range = "M"
 GoTo Reselect
 End If
 Case "M"
 Err.Clear
 EndDateCalc = DateValue(Format(FDate, "mm/31/yyyy"))
 If Err.Number > 0 Then EndDateCalc = DateValue(Format(FDate, "mm/30/yyyy"))
 End Select
Case "N"
 Select Case Range
 Case "D"
 EndDateCalc = DateValue(Format(FDate + 1, "mm/dd/yyyy"))
 Case "W"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 7), "mm/dd/yyyy")) + 7
 Case "Wm"
 EndDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 7), "mm/dd/yyyy")) + 7
 If Format(EndDateCalc, "yyyymm") > Format(FDate, "yyyymm") Then
 Range = "M"
 GoTo Reselect
 End If
 Case "M"
 Err.Clear
 EndDateCalc = DateValue(Month(FDate) + 1 & "/31/" & Format(FDate, "yyyy"))
 If Err.Number > 0 Then
 Err.Clear
 EndDateCalc = DateValue(Month(FDate) + 1 & "/30/" & Format(FDate, "yyyy"))
 If Err.Number > 0 Then
 Err.Clear
 EndDateCalc = DateValue(Month(FDate) + 1 & "/29/" & Format(FDate, "yyyy"))
 If Err.Number > 0 Then EndDateCalc = DateValue(Month(FDate) + 1 & "/28/" & Format(FDate, "yyyy"))
 End If
 End If
 End Select
End Select
End Function
Function BeginDateCalc(Range As String, Prev_or_Current As String, Optional FDate As Date) As Date
'Public Domain: This code may be used and distributed freely as long as header remains unchanged. _
'The person(s) supplying this code can not be held liable for use, misuse or damage caused by the use of this code.
'
'Allows calculation of Begin or End dates based upon the RANGE (Week, Month, Year), the DATE to use as the source or comparison date and PREV or CURRENT range. Examples:
'BeginDateCalc("W","P",#11/15/2000#) returns: 11/5/00 as the first day or the PREVIOUS WEEK is Sunday the 5th. You could easily modify the code to allow the last day of the week to be any day you wish.
'BeginDateCalc("M","P",#11/15/2000#) = 10/1/00
'BeginDateCalc("M","C",#11/15/2000#) = 11/1/00
'BeginDateCalc("Wm","C",#11/15/2000#) = 11/1/00 ' Wm is used to tell us Week but Month limited. Notice the same with "W" instead of "Wm" would result in 10/29/00
'
' Written by Chad M. Kovac
' CEO, Tech Knowledgey, Inc.
[email protected]
' http://www.TechKnowledgeyInc.com
' 10/04/00 MS Access 97/2000
On Error GoTo Errored
GoTo Main
Errored:
Call Errored_Out(Err.Source, Err.Number, Err.Description, False)
Main:
If FDate <= #1/1/1900# Then FDate = Now()
On Error Resume Next
Select Case Prev_or_Current
Case "P"
 Select Case Range
 Case "D"
 If Format(FDate, "w") = 2 Then
 BeginDateCalc = DateValue(Format(FDate - 3, "mm/dd/yyyy"))
 Else
 BeginDateCalc = DateValue(Format(FDate - 1, "mm/dd/yyyy"))
 End If
 Case "W"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") + 6), "mm/dd/yyyy"))
 Case "M"
 BeginDateCalc = DateValue(Format(FDate - (Val(Format(FDate, "dd"))), "mm/01/yyyy"))
 Case "Wm"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") + 6), "mm/dd/yyyy"))
 If Format(BeginDateCalc, "yyyymm") < Format(FDate, "yyyymm") Then _
 BeginDateCalc = Format(FDate, "mm/01/yyyy")
 End Select
Case "C"
 Select Case Range
 Case "D"
 BeginDateCalc = DateValue(Format(FDate, "mm/dd/yyyy"))
 Case "W"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 1), "mm/dd/yyyy"))
 Case "M"
 BeginDateCalc = DateValue(Format(FDate, "mm/01/yyyy"))
 Case "Wm"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 1), "mm/dd/yyyy"))
 If Format(BeginDateCalc, "yyyymm") < Format(FDate, "yyyymm") Then _
 BeginDateCalc = Format(FDate, "mm/01/yyyy")
 End Select
Case "N"
 Select Case Range
 Case "D"
 BeginDateCalc = DateValue(Format(FDate + 1, "mm/dd/yyyy"))
 Case "W"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 1), "mm/dd/yyyy")) + 7
 Case "M"
 BeginDateCalc = DateValue(Month(FDate) + 1 & "/01/" & Format(FDate, "yyyy"))
 Case "Wm"
 BeginDateCalc = DateValue(Format(FDate - (Format(FDate, "w") - 1), "mm/dd/yyyy"))
 If Format(BeginDateCalc, "yyyymm") < Format(FDate, "yyyymm") Then _
 BeginDateCalc = Format(FDate, "mm/01/yyyy")
 End Select
End Select
End Function

Download this snippet    Add to My Saved Code

Advanced Begin & End Date Calculations Simplified Comments

No comments have been posted about Advanced Begin & End Date Calculations Simplified. Why not be the first to post a comment about Advanced Begin & End Date Calculations Simplified.

Post your comment

Subject:
Message:
0/1000 characters