CODEWITHSUNDEEP
exceldate-differencevba
t.mo
t.mo

Reputation: 263

Where is the error I am missing?

This Sub will not calculate correctly if the date of birth has not been hit yet in the current year. If the DOB is 12/31/1950 it will calculate the DOB as 56, but the person is really 55 until 12/31. Is there an update I can add to accommodate for this.

Sub EE_DatedIf_ButtonC_()

    Dim wb1 As Workbook
    Dim i As Long
    Dim LastRow1 As Long
    Dim yrDiff As Long
    Dim d1 As Date
    Dim d2 As Date

    Set wb1 = Workbooks("macro all client v.01.xlsm")

    LastRow1 = wb1.Sheets("Carrier").range("F:F").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = 10 To LastRow1

        d1 = wb1.Sheets("Carrier").Cells(8, 1)

        d2 = wb1.Sheets("Carrier").Cells(i, 24)

        yrDiff = DateDiff("yyyy", d2, d1)

        wb1.Sheets("Carrier").Cells(i, 3) = yrDiff

    Next i

End Sub

Upvotes: 1

Views: 51

Answers (2)

Matt Cremeens
Matt Cremeens

Reputation: 5151

What if you took the number of month difference, divide that number by 12 and truncate

yrDiff = CInt(DateDiff("m", d2, d1) / 12)

or even more accurately, do the same with hours

yrDiff = CInt(DateDiff("h", d2, d1) / 8766)

UPDATE CInt will round, not truncate. Use this function here

Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
    Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function

And call it like so

yrDiff = Trunc(DateDiff("h", d2, d1) / 8766, 0)

Upvotes: 4

Dick Kusleika
Dick Kusleika

Reputation: 33145

If you compare the same month/day to determine if that date has passed, you will get a True or a False. In VBA True is -1 and False is 0, so you can simply add (by subtracting) when the date is already passed

Sub test()

    Dim d1 As Date, d2 As Date
    Dim yrDiff As Long

    d2 = #5/31/1950#
    d1 = #6/30/2016#

    yrDiff = Year(d1) - Year(d2) + CLng(d1 < DateSerial(Year(d1), Month(d2), Day(d2)))
    Debug.Print yrDiff

    d2 = #7/31/1950#

    yrDiff = Year(d1) - Year(d2) + CLng(d1 < DateSerial(Year(d1), Month(d2), Day(d2)))
    Debug.Print yrDiff

End Sub

Upvotes: 0

Related Questions