With monday.comâ€™s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

Hi Guys

The following function returns a string representing the date difference between two dates:

It works for dates where there is more than 1 months difference.

For example,

msgbox DateDiffEx(CDate("06 Aug 1965"), CDate(now))

returns 49 years, 2 months, 1 week, 5 days

However, the following returns 1 day which is a week out of kilter

msgbox DateDiffEx(CDate("18 Oct 2014"), CDate("26 Oct 2014"))

returns 1 day

I know the problem exists because I subtract 1 from wek

but dont know how to resolve the issue ...

MTIA

DWE

The following function returns a string representing the date difference between two dates:

```
Public Function DateDiffEx(StartDate As Variant, FinishDate As Variant) As String
Dim yer As Integer, mon As Integer, d As Integer
Dim dt As Date
Dim fd As Date
Dim sAns As String
dt = CDate(StartDate) ' our start date
fd = CDate(FinishDate) ' our finish date
yer = Year(dt) ' year of our start date
mon = Month(dt) ' month of ..
d = Day(dt) ' day of ...
yer = Year(fd) - yer ' year of our finish date
mon = Month(fd) - mon ' month of ..
d = Day(fd) - d ' day of ...
If Sgn(d) = -1 Then ' are we less than 0
d = 30 - Abs(d)
mon = mon - 1
End If
If Sgn(mon) = -1 Then
mon = 12 - Abs(mon)
yer = yer - 1
End If
Dim wek As Integer ' work our how many weeks
If d > 7 Then ' if the number of days is larger than 7 - theres a week or more in it
wek = d / 7 ' wek = days / 7
d = d Mod 7 ' d = gets the mod (remiander) after taking out whole weeks
wek = wek - 1 ' take 1 away
End If
' build our answer
If yer > 0 Then
sAns = yer & " year" & IIf(yer > 1, "(s), ", ", ")
End If
If mon > 0 Then
sAns = sAns & mon & " month" & IIf(mon > 1, "(s), ", ", ")
End If
If wek > 0 Then
sAns = sAns & wek & " Week" & IIf(wek > 1, "(s), ", ", ")
End If
If d > 0 Then
sAns = sAns & d & " Day" & IIf(d > 1, "(s)", "")
End If
'sAns = yer & " year(s) " & mon & " month(s) " & wek & " Week(s), " & d & " day(s)"
DateDiffEx = sAns
End Function
```

It works for dates where there is more than 1 months difference.

For example,

msgbox DateDiffEx(CDate("06 Aug 1965"), CDate(now))

returns 49 years, 2 months, 1 week, 5 days

However, the following returns 1 day which is a week out of kilter

msgbox DateDiffEx(CDate("18 Oct 2014"), CDate("26 Oct 2014"))

returns 1 day

I know the problem exists because I subtract 1 from wek

```
If d > 7 Then ' if the number of days is larger than 7 - theres a week or more in it
wek = d / 7 ' wek = days / 7
d = d Mod 7 ' d = gets the mod (remiander) after taking out whole weeks
wek = wek - 1 ' take 1 away
End If
```

but dont know how to resolve the issue ...

MTIA

DWE

Why not use the built-in DateDiff Function?

I found it inaccurate - I started off using it and ran into problems ... if you could show me how datediff would be used to return the same sort of string I'd be interested ...

49 years, 2 months, 11 days

which is one day different from your result but it seems to be correct because if you add two months to Aug 6 you get Oct 6 and there are 11 days between then and now (Oct 17).

BTW the function could easily be changed so that instead of 11 days it would show 1 week 4 days.

YearsMonthsDays(CDate("06 Aug 1965"), Now, True)

returns 49 years, 2 months, 12 days

its the number of weeks I am looking to include ... and I am having difficulty with ... using the example you gave, 12 days should convert to 1 week and 5 days - thats where my difficulty lay ...

YearsMonthsDays(CDate("06 Aug 1965"), Now, True)Is it still Oct 17th where you are, because here in the USA where it is the 17th I get 49 years, 2 months,

returns 49 years, 2 months, 12 days

49 years, 2 months, 5 days

or

49 years, 2 months, 0 weeks, 5 days

```
'new
Dim intPos As Integer
Dim strTemp As String
intPos = InStrRev(YearsMonthsDays, ",")
strTemp = Mid(YearsMonthsDays, intPos + 2)
If Val(strTemp) > 7 Then
strTemp = Val(strTemp) \ 7 & " weeks, " & Val(strTemp) Mod 7 & " days"
End If
YearsMonthsDays = Left$(YearsMonthsDays, intPos) & strTemp
```

```
Public Function DateDiffEx(StartDate As Variant, FinishDate As Variant) As String
Dim yer As Integer, mon As Integer, d As Integer
Dim dt As Date
Dim fd As Date
Dim sAns As String
dt = CDate(StartDate) ' our start date
fd = CDate(FinishDate) ' our finish date
yer = Year(dt) ' year of our start date
mon = Month(dt) ' month of ..
d = Day(dt) ' day of ...
yer = Year(fd) - yer ' year of our finish date
mon = Month(fd) - mon ' month of ..
d = Day(fd) - d ' day of ...
If Sgn(d) = -1 Then ' are we less than 0
d = 30 - Abs(d)
mon = mon - 1
End If
If Sgn(mon) = -1 Then
mon = 12 - Abs(mon)
yer = yer - 1
End If
Dim wek As Integer ' work our how many weeks
If d > 7 Then ' if the number of days is larger than 7 - theres a week or more in it
Debug.Print "days = " & d
wek = d / 7 ' wek = days / 7
d = (d + 1) Mod 7 ' d = gets the mod (remiander) after taking out whole weeks
wek = IIf(mon > 0, wek - 1, wek) ' take 1 away
End If
' build our answer
If yer > 0 Then
sAns = yer & " year" & IIf(yer > 1, "(s), ", ", ")
End If
If mon > 0 Then
sAns = sAns & mon & " month" & IIf(mon > 1, "(s), ", ", ")
End If
If wek > 0 Then
sAns = sAns & wek & " Week" & IIf(wek > 1, "(s), ", ", ")
End If
If d > 0 Then
sAns = sAns & d & " Day" & IIf(d > 1, "(s)", "")
End If
'sAns = yer & " year(s) " & mon & " month(s) " & wek & " Week(s), " & d & " day(s)"
DateDiffEx = sAns
End Function
```

if so its returning the correct result ...

but the value of wek is not consistantly correct? When using smaller date differences ... such as about 3 weeks ...

Can you see why ?

so it would seem that your function has some problems,

```
where TestDay = 13 ...
Dim wek As Integer ' work our how many weeks
If TestDay >= 7 Then ' if the number of days is larger than or equal to 7 - theres a week or more in it
Debug.Print "TestDay = " & TestDay
wek = TestDay / 7
Debug.Print "Wek = " & wek
TestDay = TestDay Mod 7 ' d = gets the mod (remiander) after taking out whole weeks
Debug.Print "TestDay = " & TestDay
End If
```

heres the function you posted modded to include weeks ...

```
Function YearsMonthsDays(Date1 As Date, Date2 As Date, Optional ShowAll As _
Boolean = False, Optional Grammar As Boolean = True)
' This function returns a string "X years, Y months, Z days" showing the time
' between two dates. This function may be used in any VBA or VB project
' Date1 and Date2 must either be dates, or strings that can be implicitly
' converted to dates. If these arguments have time portions, the time portions
' are ignored. If Date1 > Date2 (after ignoring time portions), the function
' returns an empty string
' ShowAll indicates whether all portions of the string "X years, Y months, Z days"
' are included in the output. If ShowAll = True, all portions of the string are
' always included. If ShowAll = False, then if the year portion is zero the year
' part of the string is omitted, and if the year portion and month portion are both
' zero, than both year and month portions are omitted. The day portion is always
' included, and if at least one year has passed then the month portion is always
' included
' Grammar indicates whether to test years/months/days for singular or plural
' By definition, a "full month" means that the day number in Date2 is >= the day
' number in Date1, or Date1 and Date2 occur on the last days of their respective
' months. A "full year" means that 12 "full months" have passed.
Dim TestYear As Long, TestMonth As Long, TestDay As Long
Dim TargetDate As Date, Last1 As Date, Last2 As Date
' Strip time portions
Date1 = Int(Date1)
Date2 = Int(Date2)
' Test for invalid dates
If Date1 > Date2 Then
YearsMonthsDays = ""
Exit Function
End If
' Test for whether the calendar year is the same
If Year(Date2) > Year(Date1) Then
' Different calendar year.
' Test to see if calendar month is the same. If it is, we have to look at the
' day to see if a full year has passed
If Month(Date2) = Month(Date1) Then
If Day(Date2) >= Day(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
' In this case, a full year has definitely passed
ElseIf Month(Date2) > Month(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
' A full year has not passed
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
' Calendar year is the same, so a full year has not passed
Else
TestYear = 0
End If
' Test to see how many full months have passed, in excess of the number of full
' years
TestMonth = (DateDiff("m", DateSerial(Year(Date1), Month(Date1), 1), _
DateSerial(Year(Date2), Month(Date2), 1)) + IIf(Day(Date2) >= _
Day(Date1), 0, -1)) Mod 12
' See how many days have passed, in excess of the number of full months. If the day
' number for Date2 is >= that for Date1, it's simple
If Day(Date2) >= Day(Date1) Then
TestDay = Day(Date2) - Day(Date1)
' If not, we have to test for end of the month
Else
Last1 = DateSerial(Year(Date2), Month(Date2), 0)
Last2 = DateSerial(Year(Date2), Month(Date2) + 1, 0)
TargetDate = DateSerial(Year(Date2), Month(Date2) - 1, Day(Date1))
If Last2 = Date2 Then
If TestMonth = 11 Then
TestMonth = 0
TestYear = TestYear + 1
Else
TestMonth = TestMonth + 1
End If
Else
TestDay = DateDiff("d", IIf(TargetDate > Last1, Last1, TargetDate), Date2)
End If
End If
' ok work out if there is a weeks calculation to be slotted in
Dim wek As Integer ' work our how many weeks
If TestDay >= 7 Then ' if the number of days is larger than or equal to 7 - theres a week or more in it
wek = TestDay \ 7
TestDay = TestDay Mod 7 ' d = gets the mod (remiander) after taking out whole weeks
End If
If ShowAll Or TestYear >= 1 Then
YearsMonthsDays = TestYear & IIf(TestYear = 1 And Grammar, " year, ", " years, ") & _
TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", " months, ") & _
wek & IIf(wek = 1 And Grammar, " week, ", " weeks, ") & _
TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
Else
If TestMonth >= 1 Then
YearsMonthsDays = TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", " months, ") & _
TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
Else
YearsMonthsDays = TestDay & IIf(TestDay = 1 And Grammar, " day", " days")
End If
End If
End Function
```

Thanks for the patient assistance ...

In my profile you'll find links to some articles I've written that may interest you.

Marty - MVP 2009 to 2014

All Courses

From novice to tech pro — start learning today.

Open in new window

Open in new window