Vba Convert days to Years, Months, Days

Question

I have this code that shows how old (by days) a file is:

Date_Created = Worksheets("FileCleaner").Range("D" & startrow).Value
File_Age_Day = DateDiff("d", Date_Created, Date)
Worksheets("FileCleaner").Range("E" & startrow).Value = File_Age_Day

Is there anyway that I can convert it to a format like this, lets say "0 Year 3 Months 3 days"?

How will you want to determine the months? Calendar or 4-4-5 weeks etc? — Nathan_Sav, Mar 11 '19 at 13:30
Sadly the answer depends both upon the number of days and the specific starting date. Say the difference in total days in *32*. If the starting date was 1/1/2018, the answer would be **1 month, 1 day**. If the starting date was 2/1/2018, the answer would be **1 month, 4 days** . — Gary's Student, Mar 11 '19 at 13:38
You can get the ideas from https://stackoverflow.com/q/453208/11683. It should be straightforward to convert that logic to VBA. — GSerg, Mar 11 '19 at 13:41
See Alex's reply in https://stackoverflow.com/questions/35802680/date-difference-with-vba-inputbox-in-years-months-days-format — Siddharth Rout, Mar 11 '19 at 14:16

score 0 · Answer 1 · answered Mar 11 '19 at 14:04

As has already been noted by other users, you're going to run into difficulties because different months have different day counts and week counts (and a given year might have different day counts as well).

I think your best bet is to "assume" that a month has a given number of days (e.g. 30) and that you're not in a leap year. Then your algorithm would be something like this:

Private Const DAYS_IN_YEAR As Integer = 365
Private Const DAYS_IN_MONTH As Integer = 30

Public Sub OutputElapsed(days As Integer)
    Dim years As Integer, months As Integer, daysRemaining As Integer

    years = Int(days / DAYS_IN_YEAR)
    daysRemaining = days - (years * DAYS_IN_YEAR)

    months = Int(daysRemaining / DAYS_IN_MONTH)
    daysRemaining = daysRemaining - (months * DAYS_IN_MONTH)

    Debug.Print _
            years & " years, " & _
            months & " months, " & _
            daysRemaining & " days"
End Sub

score 0 · Answer 2 · answered Mar 12 '19 at 17:23

This is the sub that I came up with to accomplish this task. I take a bit of a step back from your code. If I read your question right, you have a cell that contains a date Range("D" & startrow) and you then calculate the raw number of days since that date, and were then going to convert that number to years, months days. My code instead takes the string of the date from the cell (ex: 3/1/2019) and then calculates the years, months, and days passed independently. It takes into account the different days per each month and leap years and through my testing the only logic that isn't handled is if the date in the cell is actually in the future - I hope that's okay.

Sub DateCalc()
    'Worksheet Variables
    Dim mySheet As Worksheet
    Dim dateCell, outputCell As Range

    Set mySheet = Sheets("Sheet1")
    Set dateCell = mySheet.Cells(1, 1)
    Set outputCell = mySheet.Cells(1, 2)

    'Date variables
    Dim fileDate, curDate, tempDate As Date
    Dim fileYear, curYear, tempYear, years, _
    fileMonth, curMonth, tempMonth, months, _
    fileDay, curDay, tempDay, days, _
    curDPM, fileDPM _
    As Integer

    'Get date of file and calculate year, month, and day
    fileDate = dateCell.Value
    fileYear = CInt(Split(fileDate, "/")(2))
    fileMonth = CInt(Split(fileDate, "/")(0))
    fileDay = CInt(Split(fileDate, "/")(1))

    'Get the current date, year, month, and day
    curDate = Date
    curYear = CInt(Split(curDate, "/")(2))
    curMonth = CInt(Split(curDate, "/")(0))
    curDay = CInt(Split(curDate, "/")(1))

    'Calculate years passed
    If curYear > fileYear Then
        years = curYear - fileYear
    End If
    If years = "" Then
        years = 0
    End If

    'Calculate months passed
    If curMonth > fileMonth Then
        months = curMonth - fileMonth
    ElseIf curMonth = fileMonth Then
        months = 0
    ElseIf curMonth < fileMonth Then
        months = (12 - fileMonth) + curMonth
    End If

    'Calculates days per month (DPM) for current year
    Select Case curMonth
        Case 4 Or 6 Or 9 Or 11
            '31-Day months
            'April, June, September, November.
            curDPM = 30
        Case 2
            'February will either have 29 or 28 days
            'If the current year is divisible by 4 it
            'is a leap year and there are 29
            curDPM = IIf(curYear Mod 4 = 0, 29, 28)
        Case Else
            '31-Day months
            curDPM = 31
    End Select

    'Calculates days per month (DPM) for file year
    Select Case fileMonth
        Case 4 Or 6 Or 9 Or 11
            fileDPM = 30
        Case 2
            fileDPM = IIf(fileYear Mod 4 = 0, 29, 28)
        Case Else
            fileDPM = 31
    End Select

    'Calculates days passed
    If curDay > fileDay Then
        days = curDay - fileDay
    ElseIf (curDay = fileDay) Then
        days = 0
    ElseIf (curDay < fileDay) Then
        days = (fileDPM - fileDay) + curDay
    End If

    'years, months, and days are calculate independently
    'so this loop corrects them to work together
    'Ex: 12/31/2000 to 1/1/2001 would be 1 year, 1 month, 1 day without this loop
    Do
        tempDate = DateAdd("yyyy", years, fileDate)
        tempDate = DateAdd("m", months, tempDate)
        tempDate = DateAdd("d", days, tempDate)

        tempYear = CInt(Split(tempDate, "/")(2))
        tempMonth = CInt(Split(tempDate, "/")(0))
        tempDay = CInt(Split(tempDate, "/")(1))

        If tempYear > curYear Then
            years = years - 1
        ElseIf tempYear < curYear Then
            years = years + 1
        End If

        If tempMonth > curMonth Then
            months = months - 1
        ElseIf tempMonth < tempMonth Then
            months = months + 1
        End If

        If tempDay > curDay Then
            days = days - 1
        ElseIf tempDay < curDay Then
            days = days + 1
        End If
    Loop While tempDate <> curDate

    'Set cell to display time passed
    outputCell.Value = years & " Years, " & months & " Months, " & days & " Days"
End Sub

This is the output All you should have to do to make it work for your individual worksheet is change the mySheet, dateCell, and outputCell variables. My date cells are set to the format of mm/dd/yyyy. I have not tested it with other date formats.

Jonathan Handojo · Answer 3 · 2020-01-10T21:20:40.503

Here's my solution. I'm using this in my company, though it's written in Indonesian language as that's where I come from. It's a function where it takes two arguments: tanggal_akhir (which translates to 'start date') and tanggal_mulai (which translates to 'end date'). Formula is BEDATANGGAL which means 'date difference'. Hope it helps.

Function BEDATANGGAL(tanggal_mulai As Date, tanggal_akhir As Date)

Dim hari As Integer
Dim bulan As Integer
Dim tahun As Integer
Dim durasi As Integer
Dim tambah As Date

hari = 0
bulan = 0
tahun = 0
tambah = tanggal_mulai

durasi = DateDiff("d", tanggal_mulai, tanggal_akhir) - 1

For i = 0 To durasi

hari = hari + 1
tambah = tambah + 1

If Day(tanggal_mulai) = Day(tambah) Then

    hari = 0
    bulan = bulan + 1

    End If

If bulan = 12 Then

    hari = 0
    bulan = 0
    tahun = tahun + 1

    End If

Next i

BEDATANGGAL = tahun & " tahun, " & bulan & " bulan, " & hari & " hari"

End Function

score 0 · Answer 4 · answered Mar 26 '21 at 01:10

Modification to the above answer by tyler

Function date_duration(start_date, end_date)
'Worksheet Variables

Dim dateCell, outputCell As Range



'Date variables
Dim fileDate, curDate, tempDate As Date
Dim fileYear, curYear, tempYear, years, _
fileMonth, curMonth, tempMonth, months, _
fileDay, curDay, tempDay, days, _
curDPM, fileDPM _
As Integer

'Get date of file and calculate year, month, and day
fileDate = start_date
fileYear = CInt(Split(fileDate, "/")(2))
fileMonth = CInt(Split(fileDate, "/")(0))
fileDay = CInt(Split(fileDate, "/")(1))

'Get the current date, year, month, and day
curDate = end_date
curYear = CInt(Split(curDate, "/")(2))
curMonth = CInt(Split(curDate, "/")(0))
curDay = CInt(Split(curDate, "/")(1))

'Calculate years passed
If curYear > fileYear Then
    years = curYear - fileYear
End If
If years = "" Then
    years = 0
End If

'Calculate months passed
If curMonth > fileMonth Then
    months = curMonth - fileMonth
ElseIf curMonth = fileMonth Then
    months = 0
ElseIf curMonth < fileMonth Then
    months = (12 - fileMonth) + curMonth
End If

'Calculates days per month (DPM) for current year
Select Case curMonth
    Case 4 Or 6 Or 9 Or 11
        '31-Day months
        'April, June, September, November.
        curDPM = 30
    Case 2
        'February will either have 29 or 28 days
        'If the current year is divisible by 4 it
        'is a leap year and there are 29
        curDPM = IIf(curYear Mod 4 = 0, 29, 28)
    Case Else
        '31-Day months
        curDPM = 31
End Select

'Calculates days per month (DPM) for file year
Select Case fileMonth
    Case 4 Or 6 Or 9 Or 11
        fileDPM = 30
    Case 2
        fileDPM = IIf(fileYear Mod 4 = 0, 29, 28)
    Case Else
        fileDPM = 31
End Select

'Calculates days passed
If curDay > fileDay Then
    days = curDay - fileDay
ElseIf (curDay = fileDay) Then
    days = 0
ElseIf (curDay < fileDay) Then
    days = (fileDPM - fileDay) + curDay
End If

'years, months, and days are calculate independently
'so this loop corrects them to work together
'Ex: 12/31/2000 to 1/1/2001 would be 1 year, 1 month, 1 day without this loop
Do
    tempDate = DateAdd("yyyy", years, fileDate)
    tempDate = DateAdd("m", months, tempDate)
    tempDate = DateAdd("d", days, tempDate)

    tempYear = CInt(Split(tempDate, "/")(2))
    tempMonth = CInt(Split(tempDate, "/")(0))
    tempDay = CInt(Split(tempDate, "/")(1))

    If tempYear > curYear Then
        years = years - 1
    ElseIf tempYear < curYear Then
        years = years + 1
    End If

    If tempMonth > curMonth Then
        months = months - 1
    ElseIf tempMonth < tempMonth Then
        months = months + 1
    End If

    If tempDay > curDay Then
        days = days - 1
    ElseIf tempDay < curDay Then
        days = days + 1
    End If
Loop While tempDate <> curDate

'Set cell to display time passed
date_duration = years & " Years, " & months & " Months, " & days & " Days"
End Function

score 0 · Answer 5 · answered Aug 01 '23 at 06:18

Its been long time but maybe useful to someone.

Public Function convertToYMD(days As Integer) As String
    Dim intYears As Integer
    Dim intMonths As Integer
    Dim intDays As Integer
    Dim strY As String
    Dim strM As String
    Dim strD As String
    
    intYears = Evaluate("DATEDIF(0," & days & ",""y"")")
    intMonths = Evaluate("DATEDIF(0," & days & ",""ym"")")
    intDays = Evaluate("DATEDIF(0," & days & ",""md"")")
    
    If intYears > 0 Then
        If intYears = 1 Then
            strY = "1 Year, "
        Else
            strY = intYears & " Years, "
        End If
    End If
    If intMonths > 0 Then
        If intMonths = 1 Then
            strM = "1 Month "
        Else
            strM = intMonths & " Months "
        End If
    End If
    If intDays > 0 Then
        If intDays = 1 Then
            strD = "and 1 Day"
        Else
            strD = "and " & intDays & " Days"
        End If
    End If
    
    
    convertToYMD = strY & strM & strD
End Function

score -1 · Answer 6 · answered Mar 11 '19 at 13:35

Try the following.

date_created = Worksheets("FileCleaner").Range("D" & startrow).Value
File_Age_Day = DatePart("yyyy", date_created) & " years, " & DatePart("M", 
date_created) & " Months, " & DatePart("d", date_created) & " days"
Worksheets("FileCleaner").Range("E" & startrow).Value = File_Age_Day

Vba Convert days to Years, Months, Days

6 Answers6