UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Date\Time Functions, Any Version    
 
   
CyberCow
post Mar 28 2012, 11:54 PM
Post#1


UdderAccess Admin + UA Ruler
Posts: 19,557
Joined: 27-April 02
From: Upper MI


A few years ago I found some class code and made some modifications to it. Tried to find where it was posted here before, but I was unsuccessful in locating the original post and thought it would most likely be here in the Code Archive, but I guess it was never posted in its entirety here. So, based on Allen Browne's "Returning more than one value from a function", our own Bob "raskew" generated some very handy Date & Time functions; with modifications by UA's datAdrenaline and myself.
On the code you'll see a couple of different versions of a "GetAge" function and a few other goodies for handling, determining and manipulating date\time values. The three constants at the top are not used specifically in the code, but are there to provide very accurate constants for 'seconds', 'minutes' and 'hours' that can be applied against a whole day value, which is "1".
May you find this useful.
Modified on 11-8-2012 by Cybercow - added myGetHours function
Modified on 11-14-2012 by Cybercow - added DateAsWords function (Change Date to Words)
Modified on 11-24-2012 by Cybercow - added myWeekRange (Going from Week Number to Date Range)
Modified on 11-28-2012 by Cybercow - corrected date constants at the top (thanks moishy) and incorporatd dflak's PriorDOW function without the Excel declaration for use in Access)

Attached File(s)
Attached File  1984749.zip ( 7.12K )Number of downloads: 239
 
Go to the top of the page
 
CyberCow
post Nov 8 2012, 10:40 AM
Post#2


UdderAccess Admin + UA Ruler
Posts: 19,557
Joined: 27-April 02
From: Upper MI


Update Note: original post code updated . . .
dded "myGetHours" function to render the difference between two date/time values.
The two date/time values can be provided as strings or dates.
The output can be modified to render d:h:m or x days, y hours, z minutes or other by tweaking the code at line 330 & 340 accordingly.
Go to the top of the page
 
dflak
post Nov 9 2012, 11:36 AM
Post#3


Utter Access VIP
Posts: 6,230
Joined: 22-June 04
From: North Carolina


I would like to submit the following for inclusion as a Datetime Function. I developed it for Excel, but it should also work in Access. Give it a date and a day of the week. It will return the last prior date on which the day of the week occured. For example if TODAY() is Monday then PriorDOW(TODAY(),"Fri") is last Friday. PriorDOW(Today(),"Mon") is the previous Monday unless an optional TRUE flag is used. The TRUE flag allows the function to return the currrent date. Most of the reports I run are due as of the previous whatever-day-of-week.
CODE
Option Explicit
unction PriorDOW(MyDate As Date, DOW As String, Optional UseToday As Boolean) As Date
Dim WD As Long
Dim DOWNum As Long
Dim NewDate As Date
Dim Subtractor As Long
Application.Volatile
WD = WeekDay(MyDate, vbMonday) - 1
If UseToday = True Then
    Subtractor = 0
Else
    Subtractor = 7
End If
Select Case DOW
    Case "Mon"
        DOWNum = 0
    Case "Tue"
        DOWNum = 1
    Case "Wed"
        DOWNum = 2
    Case "Thu"
        DOWNum = 3
    Case "Fri"
        DOWNum = 4
    Case "Sat"
        DOWNum = 5
    Case "Sun"
        DOWNum = 6
    Case Else
        DOWNum = 0
End Select
If WD = DOWNum Then
    NewDate = MyDate - Subtractor
Else
    NewDate = MyDate - (WD + 7 - DOWNum)
End If
If MyDate - NewDate > 7 Then
    NewDate = NewDate + 7
End If
PriorDOW = NewDate
End Function
Go to the top of the page
 
CharlesWilliams
post May 14 2015, 11:04 AM
Post#4



Posts: 124
Joined: 3-September 02
From: Philadelphia, PA


Here is my couple of tweaks to the DateAsWords code as follows:

Dim tm As String

Select Case Right(Day(dt), 1)
Case 1
If Day(dt) > 9 And Day(dt) < 14 Then
DateAsWords = Day(dt) & "th"
Else
DateAsWords = Day(dt) & "st"
End If
Case 2
If Day(dt) > 9 And Day(dt) < 14 Then
DateAsWords = Day(dt) & "th"
Else
DateAsWords = Day(dt) & "st"
End If
Case 3
If Day(dt) > 9 And Day(dt) < 14 Then
DateAsWords = Day(dt) & "th"
Else
DateAsWords = Day(dt) & "nd"
End If
Case 4
If Day(dt) > 9 And Day(dt) < 14 Then
DateAsWords = Day(dt) & "th"
Else
DateAsWords = Day(dt) & "rd"
End If
Case Else
DateAsWords = Day(dt) & "th"
End Select

Select Case f
Case 0
' Change nothing
Case 1
DateAsWords = Format(dt, "mmmm") & " " & DateAsWords & ", " & Year(dt)
Case 2
DateAsWords = Format(dt, "dddd") & " " & Format(dt, "mmmm") & " " & DateAsWords & ", " & Year(dt)
Case 3
DateAsWords = DateAsWords & " of " & Format(dt, "mmmm") & ", " & Year(dt)
Case 4
DateAsWords = DateAsWords & " of " & Format(dt, "mmmm")
End Select

In my tweaks I made case 2 case 3 and case 3 case 4. I made case 2 and added the day of the week in the beginning. (Re: Thursday May 14th, 2015) for those who would want to show the day of the week before the date.

This is just my personal tweak.

- Charles
Go to the top of the page
 
ZapDude
post May 26 2018, 11:43 PM
Post#5



Posts: 292
Joined: 27-February 06
From: Long Beach CA


RE dflak's "last Friday" function: VBA (and VB) has a constant Weekday assignment where vbSunday = 1, vbMonday = 2, ... vbSaturday = 7. These are Integer, Long, or other whole number datatypes. In addition, the date value itself can be made optional and default to today's date if not passed, simplifying it even more.

Full function. Note I changed DOW to be a Long rather than a String, remembering Sunday=1 through Saturday=7. The return is the date of the previous designated day of week. Finally, I added one more optional value, in which if the Day of Week is the same as the day of the Date passed, then it defaults to the previous week's Day of Week. If you pass the optional value as true, and the Day of Week is the same as the day of the Date passed, the actual Date passed date will be used.

I left the function with my normal full labeling and formatting. If you wish, you can strip away all comments, labels, the description, and even the error handler. Up to you.

CODE
Public Function fncPrevDOW( _
      ByVal lngDOW As Long, _
      Optional ByVal datCheckDate As Date, _
      Optional ByVal blnUseToday As Boolean _
      ) As Date
'-----------------------------------------------------------------------------------------
' Procedure : fncPrevDOW
' Created   : 5/26/2018 22:22
' Reference : fncPrevDOW*
' Author    : Michael
' Input(s)  : lngDOW - the Day of Week to return previous to datCheckDate, range 1 - 7,
'           :   with Sun=1, Mon=2, ...Sat=7. NOTE: Use VB Constants for ease of code
'           :   (ie, "vbSaturday", "vbTuesday", etc.)
'           : datCheckDate (optional) - Date to assess previous day of week from
'           :   NOTE: If datCheckDate is missing, then current date will be assigned
'           : blnUseToday (optional) - If blnUseToday is True, then if lngDOW is equal to
'           :   the weekday of datCheckDate, then datCheckDate will be returned. Otherwise
'           :   the previous date for the Day of Week will be used for the return Date
' Output(s) : datPrevDow - date of the passed lngDOW
' Misc      : You can just extract the equation in PROC_MAIN if you would rather not port
'           :   the entire function. Just ensure you have all variables assigned properly
'-----------------------------------------------------------------------------------------

'|<------ 90-character width -------------------------------- 90-character width ------->|

PROC_DECLARATIONS:
   Dim datPrevDOW As Date
  
PROC_START:
   On Error GoTo PROC_ERROR
   If CLng(datCheckDate) = 0 Then
      datCheckDate = Date
   End If
      
PROC_MAIN:
   datPrevDOW = CDate(datCheckDate - (Weekday(datCheckDate, lngDOW) - 1) - _
         (((Not blnUseToday) * (Weekday(datCheckDate) = lngDOW)) * 7))
  
PROC_EXIT:
   fncPrevDOW = datPrevDOW
   Exit Function

PROC_ERROR:
   MsgBox "Error " & Err.Number & " (" & _
           Err.Description & ")" & vbCrLf & vbCrLf & _
           "Procedure: fncPrevDOW" & vbCrLf & _
           "Module: basWeekdayFunction"
   GoTo PROC_EXIT

End Function


Go to the top of the page
 
ZapDude
post May 26 2018, 11:55 PM
Post#6



Posts: 292
Joined: 27-February 06
From: Long Beach CA


Re CharlesWilliams: Regarding the cardinal date equation, where the number is in cardinal form (1st, 2nd, 3rd, 4th, etc), I created a single line of code using the switch function (wrapped for clarity). Note the switch function works similar to a Select Case protocol, where the first instance of a True equation ends the sequence. The final equation, True, is similar to a Case Else catchall.

CODE
strCardinal = CStr(lngDayOfMonth) _
      & Switch( _
      lngDayOfMonth Mod 100 >= 11 And lngDayOfMonth Mod 100 <= 13, "th", _
      lngDayOfMonth Mod 10 = 1, "st", _
      lngDayOfMonth Mod 10 = 2, "nd", _
      lngDayOfMonth Mod 10 = 3, "rd", _
      True, "th")

The return is the day of month in cardinal form as String. You can append it to other data as needed (i.e. "May 2nd", etc.). In addition, you can create a function, just creating a number variable for the Day of Month to pass.
This post has been edited by ZapDude: May 26 2018, 11:59 PM
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    22nd October 2018 - 02:27 PM