-
Mar 5th, 2004, 07:22 PM
#1
Thread Starter
PowerPoster
Display difference between 2 dates in Years, Months & Days
This function needs DateOne to be earlier than DateTwo, I used this code elsewhere, but it could just as easily be incorporated in the Function:
VB Code:
If DateTwo < DateOne Then ' Make sure that first date is the smaller of the two
Dim Temp As DateTime
Temp = DateOne ' Swap them if not
DateOne = DateTwo
DateTwo = Temp
End If
And here is the main function:
VB Code:
Private Function Y_M_D_Diff(ByVal DateOne As DateTime, ByVal DateTwo As DateTime) As String
Dim Year, Month, Day As Integer
' Function to display difference between two dates in Years, Months and Days, calling routine ensures that DateOne is always earlier than DateTwo
If DateOne <> DateTwo Then ' If both dates the same then exit with zeros returned otherwise a difference of one year gets returned!!!
' Years
If DateTwo.Year > DateOne.Year Then ' If year is the same in both dates, an out of range exception is thrown!!!
Year = DateTwo.AddYears(-DateOne.Year).Year ' Subtract DateOne years from DateTwo years to get difference
End If
' Months
Month = DateTwo.AddMonths(-DateOne.Month).Month ' Subtract DateOne months from DateTwo months
If DateTwo.Month <= DateOne.Month Then ' Decrement year by one if DateTwo months hasn't exceeded DateOne months, i.e. not full year yet
If Year > 0 Then Year -= 1
End If
' Days
Day = DateTwo.AddDays(-DateOne.Day).Day ' Subtract DateOne days from DateTwo days
If DateTwo.Day <= DateOne.Day Then ' Decrement month by one if DateTwo days hasn't exceeded DateOne days - not full month yet
If Month > 0 Then Month -= 1
End If
If DateOne.Day = DateTwo.Day Then ' Avoid silliness like "1 month 31 days" instead of 2 months
Day = 0 ' Reset days
Month += 1 ' And increment month
End If
' Corrections
If Month = 12 Then ' Months value goes up to 12, and we want a maximum of 11, so:
Month = 0 ' Reset months to zero
Year += 1 ' And increment year
End If
If DateOne.Year = DateTwo.Year AndAlso DateOne.Month = DateOne.Month Then ' If year and month are the same in DateOne & DateTwo then month = 12 and therefore year has been incremented
Year = 0 ' So reset it
End If
End If ' DateOne <> DateTwo
Return Year & " years, " & Month & " months, " & Day & " days" ' Concatenate string and return to calling routine
End Function ' Y_M_D_Diff
-
Mar 6th, 2004, 04:55 PM
#2
without sounding funny , isn't the idea that if you post an example , which has in a large part been coded by someone else ( ie: in this case the code example i made and gave you via a link in the vb.net section ) , you could maybe add a " built with help by ... " or " this code was built by the help of ... "
here's the original link on vb.net section where you posted to ask how to build this function / get it to work ... Converting days to yy/mm/dd (Resolved)
~
if a post is resolved, please mark it as [Resolved]
protected string get_Signature(){return Censored;}
[vbcode][php] please use code tags when posting any code [/php][/vbcode]
-
Mar 6th, 2004, 06:32 PM
#3
Thread Starter
PowerPoster
Yes, you're right, I appreciate the help I was given, and the above was indeed inspired by what you gave me. However there's about 1 line of the original code in that, I had to completely recode the thing to get it to work properly when using 2 arbitrary dates. The original code gave logic errors in numerous places when I tried it. So I really didn't feel that it was "in large part coded by somebody else".
But I certainly don't want to step on any toes, or cause any offence - this is an excellent site, and I want to fit in here.
So, the above code was inspired by Dynamic_Sysop, to give credit where it's due.
-
Apr 27th, 2004, 06:44 PM
#4
Frenzied Member
Super Spark, you are a really cool guy. I know you from the other forum. You always try to help and very polite.
I'll Be Back!
T-1000
Microsoft .Net 2005
Microsoft Visual Basic 6
Prefer using API
-
Mar 2nd, 2005, 04:44 PM
#5
New Member
Re: Display difference between 2 dates in Years, Months & Days
Hi,
Thanks both of you for the code posted. I had an error in my case but I fixed it, and it was my logical error, not the error in your code.
It works just fine. I appreciate your help guys.
_dino_
Last edited by _dino_; Mar 2nd, 2005 at 04:55 PM.
-
Mar 12th, 2013, 03:34 PM
#6
New Member
Re: Display difference between 2 dates in Years, Months & Days
I think this one is simpler (VB6)
Code:
Private Sub Y_M_D_Diff(DateOne As Date, DateTwo As Date)
Dim FechaCalculada As Date
FechaCalculada = DateOne
Anios = -1
While FechaCalculada < DateTwo
FechaCalculada = DateAdd("yyyy", 1, FechaCalculada)
Anios = Anios + 1
Wend
FechaCalculada = DateAdd("yyyy", -1, FechaCalculada)
Meses = -1
While FechaCalculada < DateTwo
FechaCalculada = DateAdd("m", 1, FechaCalculada)
Meses = Meses + 1
Wend
FechaCalculada = DateAdd("m", -1, FechaCalculada)
Dias = 1
While FechaCalculada < DateTwo
FechaCalculada = DateAdd("d", 1, FechaCalculada)
Dias = Dias + 1
Wend
End Sub
.
.
.
.
Debug.Print Anios
Debug.Print Meses
Debug.Print Dias
.
.
-
Feb 5th, 2014, 05:49 PM
#7
New Member
Re: Display difference between 2 dates in Years, Months & Days
U resume an very old post... so do I!
Originally Posted by noelpv
I think this one is simpler (VB6)
yes but it's wrong.
I'll insert comments to correct it...
Originally Posted by noelpv
Code:
Private Sub Y_M_D_Diff(DateOne As Date, DateTwo As Date)
Dim FechaCalculada As Date
it's a good behaviour to declare other variables too... Anios, Mesos, Dias
Code:
FechaCalculada = DateOne
Anios = -1
While FechaCalculada < DateTwo
here u have logical error like the 2 comparisons below. u have to add the = operator!!!
Code:
FechaCalculada = DateAdd("yyyy", 1, FechaCalculada)
Anios = Anios + 1
Wend
FechaCalculada = DateAdd("yyyy", -1, FechaCalculada)
why do u go back this way? it's dangerous not for year,....
Code:
Meses = -1
While FechaCalculada < DateTwo
FechaCalculada = DateAdd("m", 1, FechaCalculada)
Meses = Meses + 1
Wend
FechaCalculada = DateAdd("m", -1, FechaCalculada)
...but for month! Infact....
suppose u have dateone=31/08/2014 and datetwo=31/08/2015 (exactly 1 year):
in prewious while u have added a month to 31/08/2015 and u arrived to 30/09/2015
now u subtract a month and the result is.... 30/08/2015!!! so now u have to add 1 day to reach datetwo!!!
Code:
Dias = 1
While FechaCalculada < DateTwo
FechaCalculada = DateAdd("d", 1, FechaCalculada)
Dias = Dias + 1
Wend
End Sub
.
.
.
.
Debug.Print Anios
Debug.Print Meses
Debug.Print Dias
.
.
here is the corrected code, just cut and paste in a new form to test.
Code:
Private Type timeElapsed
years As Integer
months As Integer
days As Integer
End Type
Private Function Y_M_D_Diff(ByVal DateOne As Date, ByVal DateTwo As Date) As timeElapsed
Dim FechaCalculada As Date
Dim Anios, Meses, Dias As Integer
FechaCalculada = DateOne
Anios = -1
While FechaCalculada <= DateTwo
FechaCalculada = DateAdd("yyyy", 1, FechaCalculada)
Anios = Anios + 1
Wend
FechaCalculada = DateAdd("yyyy", Anios, DateOne)
Meses = -1
While FechaCalculada <= DateTwo
FechaCalculada = DateAdd("m", 1, FechaCalculada)
Meses = Meses + 1
Wend
FechaCalculada = DateAdd("m", Meses, DateAdd("yyyy", Anios, DateOne))
Dias = -1
While FechaCalculada <= DateTwo
FechaCalculada = DateAdd("d", 1, FechaCalculada)
Dias = Dias + 1
Wend
End Function
Private Sub Form_Load()
Dim date1, date2 As Date
Dim timeToDate2 As timeElapsed
date1 = CDate("2014/08/31")
date2 = CDate("2015/08/31") '1 year
'uncomment lines below to make other tests
'Date2 = CDate("2014/09/30") '1 month
'Date2 = CDate("2014/09/01") '1 day
'Date2 = CDate("2014/08/31") '0 days
timeToDate2 = Y_M_D_Diff(date1, date2)
MsgBox timeToDate2.years & " years, " & timeToDate2.months & " months and " & timeToDate2.days & " days"
Unload Form1
End Sub
Hope that would help!
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|