Calculating date and formating to Months, Weeks, and Days

**googalabosh** · 10-26-2018, 08:31 AM

I want to create a querey that calculates the DateDiff and displays it in Months, Weeks, and Days. For example:

2 Months, 3 Weeks, and 4 Days

How do I do this?

Thanks in advanced!

**Minty** · 10-26-2018, 08:47 AM

Not easily.

One main reason is - (And I'm not being difficult here but think about this) Explain to me how long a month is?

**ranman256** · 10-26-2018, 08:51 AM

put this code into a module then..

usage:
= CalcElapsedTimeAsTxt (Date1, Date2)

Code:

Public Function CalcElapsedTimeAsTxt(ByVal pvDate1, ByVal pvDate2)
Dim lSecs As Long
lSecs = DateDiff("s", pvDate1, pvDate2)
CalcElapsedTimeAsTxt = ElapsedTimeAsTextRecur(lSecs)
End Function


'USAGE:  ElapsedTimeAsTextRecur(655)
Public Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock)
'recursive time lapse given seconds
Dim vTxt
Dim iNum As Long
Const kDAY = 86400
Const kSECpYR = 31536000


'60 sec = 1 min             60 sec
'60 min = 1 hr            3600 sec
'24 hr = 1 day           86400 sec
'7 days = 1 week        604800 sec
'30 days = 1 month     2592000
'12 months = 1 year = 31536000


'YEARS
If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR
iNum = pvSecs \ pvSecBlock
    
    Select Case pvSecBlock
       Case kSECpYR   'yr
          sUnit = "years"
          If iNum > 0 Then
               vTxt = iNum & " years "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000)
          
      Case 2592000    'MO
          sUnit = "months"
          If iNum > 0 Then
               If iNum > 11 Then iNum = 11
               vTxt = vTxt & iNum & " months "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800)
       
       Case 604800     'WEEK
          sUnit = "weeks"
          If iNum > 0 Then
               If iNum > 3 Then iNum = 3
               vTxt = vTxt & iNum & " weeks "
               pvSecs = pvSecs - (iNum * kDAY * 7)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400)
       
       Case kDAY      'day
          sUnit = "days"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " days "
               pvSecs = pvSecs - (iNum * kDAY)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600)
       
       Case 3600       'hrs
          sUnit = "hrs"
          If iNum > 23 Then iNum = 23
          If iNum > 0 Then
               vTxt = vTxt & iNum & " hrs "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60)
       
       Case 60         'min
          sUnit = "mins"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " mins "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1)
       
       Case Else
          
          sUnit = "secs"
          If pvSecs > 0 Then vTxt = vTxt & pvSecs & " seconds"
    End Select
    
ElapsedTimeAsTextRecur = vTxt
End Function

**googalabosh** · 10-26-2018, 09:21 AM

Originally Posted by ranman256

put this code into a module then..

usage:
= CalcElapsedTimeAsTxt (Date1, Date2)

Code:

Public Function CalcElapsedTimeAsTxt(ByVal pvDate1, ByVal pvDate2)
Dim lSecs As Long
lSecs = DateDiff("s", pvDate1, pvDate2)
CalcElapsedTimeAsTxt = ElapsedTimeAsTextRecur(lSecs)
End Function


'USAGE:  ElapsedTimeAsTextRecur(655)
Public Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock)
'recursive time lapse given seconds
Dim vTxt
Dim iNum As Long
Const kDAY = 86400
Const kSECpYR = 31536000


'60 sec = 1 min             60 sec
'60 min = 1 hr            3600 sec
'24 hr = 1 day           86400 sec
'7 days = 1 week        604800 sec
'30 days = 1 month     2592000
'12 months = 1 year = 31536000


'YEARS
If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR
iNum = pvSecs \ pvSecBlock
    
    Select Case pvSecBlock
       Case kSECpYR   'yr
          sUnit = "years"
          If iNum > 0 Then
               vTxt = iNum & " years "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000)
          
      Case 2592000    'MO
          sUnit = "months"
          If iNum > 0 Then
               If iNum > 11 Then iNum = 11
               vTxt = vTxt & iNum & " months "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800)
       
       Case 604800     'WEEK
          sUnit = "weeks"
          If iNum > 0 Then
               If iNum > 3 Then iNum = 3
               vTxt = vTxt & iNum & " weeks "
               pvSecs = pvSecs - (iNum * kDAY * 7)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400)
       
       Case kDAY      'day
          sUnit = "days"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " days "
               pvSecs = pvSecs - (iNum * kDAY)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600)
       
       Case 3600       'hrs
          sUnit = "hrs"
          If iNum > 23 Then iNum = 23
          If iNum > 0 Then
               vTxt = vTxt & iNum & " hrs "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60)
       
       Case 60         'min
          sUnit = "mins"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " mins "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1)
       
       Case Else
          
          sUnit = "secs"
          If pvSecs > 0 Then vTxt = vTxt & pvSecs & " seconds"
    End Select
    
ElapsedTimeAsTextRecur = vTxt
End Function

It's saying "Undefined function 'CalcElapsedTimeAsTxt' in expression".

**Minty** · 10-26-2018, 09:27 AM

If you are going to stick at 30 days per month then;

Code:

Function MWDay(StartDate As Date, EndDate As Date) As String


    Dim iMonths As Integer
    Dim iWeeks As Integer
    Dim iDays As Integer
    
    Dim iTotDays As Integer
    
    iTotDays = DateDiff("d", StartDate, EndDate)
    
    Debug.Print iTotDays
    
    iMonths = Int(iTotDays / 30)
    iDays = (iTotDays - (iMonths * 30))
    Debug.Print iDays
    If iDays <= 7 Then
        iWeeks = 0
    Else
        iWeeks = Int(iDays / 7)
    End If
    
    iDays = iTotDays - (iMonths * 30) - (iWeeks * 7)
    
    
    MWDay = iMonths & " Month(s) " & iWeeks & " Week(s) " & iDays & " Day(s)"
    


End Function

**googalabosh** · 10-26-2018, 01:13 PM

Originally Posted by Minty

If you are going to stick at 30 days per month then;

Code:

Function MWDay(StartDate As Date, EndDate As Date) As String


    Dim iMonths As Integer
    Dim iWeeks As Integer
    Dim iDays As Integer
    
    Dim iTotDays As Integer
    
    iTotDays = DateDiff("d", StartDate, EndDate)
    
    Debug.Print iTotDays
    
    iMonths = Int(iTotDays / 30)
    iDays = (iTotDays - (iMonths * 30))
    Debug.Print iDays
    If iDays <= 7 Then
        iWeeks = 0
    Else
        iWeeks = Int(iDays / 7)
    End If
    
    iDays = iTotDays - (iMonths * 30) - (iWeeks * 7)
    
    
    MWDay = iMonths & " Month(s) " & iWeeks & " Week(s) " & iDays & " Day(s)"
    


End Function

I'm getting the same error message for your code: "Undefined function 'MWDay' in expression.". I created the Module and named it MWDay. In the querey, in the Field row, I created a new column that states "Exp1: MWDay([Date in], [Date out])". Am I missing something?

**ssanfu** · 10-26-2018, 06:05 PM

Originally Posted by googalabosh

I created the Module and named it MWDay.

You CANNOT have a module name the same name as a function name.

Name the module to some other name - maybe "modCalculations" or "MYFunctions"

**googalabosh** · 10-26-2018, 06:50 PM

Originally Posted by ssanfu

You CANNOT have a module name the same name as a function name.

Name the module to some other name - maybe "modCalculations" or "MYFunctions"

Ah! Thank you. I'll have to fix it on Monday when I get back to work. That was my first time actually messing with Modules.

Thanks again for the tip.

**CJ_London** · 10-27-2018, 03:14 AM

an alternative function which takes into account the lengths of months would be

Code:

Function mwd(d1 As Date, d2 As Date) As String
Dim m As Integer
Dim w As Integer
Dim d As Integer

   m = DateDiff("m", d1, d2)
   w = DateDiff("d", DateAdd("m", m, d1), d2) \ 7
   d = DateDiff("d", DateAdd("m", m, d1), d2) Mod 7

   If m <> 0 Then mwd = m & " months, "
   If w <> 0 Then mwd = mwd & w & " weeks"
   If d <> 0 Then mwd = mwd & " and " & d & " days"

End Function

**googalabosh** · 10-30-2018, 06:34 AM

All,

I was able to get it to work with the code from Minty. I tried the code from ranman256 but it wasn't working right. Just kept outputing the date for some reason.

Ajax, I didn't try your code (yet) only because Minty's worked. However, I will at some point since that references the different days of each month.

Thanks again to everyone for your help!

-Justin

Calculating date and formating to Months, Weeks, and Days

Thread Tools

Calculating date and formating to Months, Weeks, and Days

Similar Threads

Calculating days bewteen previous date and next date in the same date field

calculating a field in a query to add 16 days to the last departure date record

Calculating days between Start Date and Today ?

Search by weeks and or months (dates)

Query to autofill date and calculate duration in days months and years

Tags for this Thread

Posting Permissions