Custom function that is more accurate than worksheet function DateDif for calculating work experi.

Hi folks,

Recently I needed to calculate work experience for some workers and I tried to use DateDif function but I noticed it isn't 100% accurate. For example If I have start date as Jan 1st 2019 and end date as Dec 31st 2019 I get result: 0 y, 11 m and 30 days. When I add 1 day I still get 0 y, 11 m and 31 days, but I should get 1 y, 0 m and 0 days. Also if start date is Jan 1st 2020 and final date is Feb 29th 2020 I get result (added 1 day when no. of day is calculated): 0 y , 1 m and 29 days, but I should get only 2 months.

I was looking all over WWW but I couldn't find precise function so I wrote custom function by myself. I hope it will help somebody.

Function work_experiance(StartDate As Double, EndDate As Double, n As String) As Integer

Dim nYears As Integer, nMonths As Integer, nDays As Integer
Dim x As Double, z As Double
Dim a As Integer, b As Integer

z = Application.WorksheetFunction. _
Days360(StartDate, EndDate, True)
'calculates total number of date based on 360 days (EU Method)
x = z / 30
nYears = Int(x / 12) 'number of years
nMonths = Int(z / 30) - nYears * 12 'number of months

If Day(EndDate) >= Day(StartDate) Then
nDays = Day(EndDate) - Day(StartDate) + 1
Else
a = Day(Application.WorksheetFunction.EoMonth(EndDate, -1)) - _
Day(StartDate) + 1
b = EndDate - Application.WorksheetFunction.EoMonth(EndDate, -1)
nDays = a + b
End If

If nDays = 31 Then
nDays = 0
nMonths = nMonths + 1
If nMonths = 12 Then
nMonths = 0
nYears = nYears + 1
End If
End If

If Year(EndDate) Mod 4 = 0 And Month(EndDate) = 2 And Day(EndDate) = 29 And nDays = 29 Then
nDays = 0
nMonths = nMonths + 1
If nMonths = 12 Then
nMonths = 0
nYears = nYears + 1
End If
End If

If Year(EndDate) Mod 4 <> 0 And Month(EndDate) = 2 And Day(EndDate) = 28 And nDays = 28 Then
nDays = 0
nMonths = nMonths + 1
If nMonths = 12 Then
nMonths = 0
nYears = nYears + 1
End If
End If

Select Case n
Case "y"
work_experiance = nYears
Case "m"
work_experiance = nMonths
Case "d"
work_experiance = nDays
End Select

End Function