I have 2 comboboxes and 2 textboxes. My first combobox contains months in this format january, february, etc, and the other combobox contains numbers from 1 to 31. My first textbox is txtyear. Once the user input birth year to txtyear a variable BOD will be equals to this.
Dim BOD as string
BOD = cbomonth.text + "-" + cboday.text + "-" + txtyear.text
The purpose of my last textbox is to handle the age of the user that will be computed when the cursor lost focus on txtyear.
Can anyone help how to compute the age.
There are really two questions here:
How to convert the string input into a DateTime object
How to calculate age once you have your data in the correct format.
I'll let you follow other's instructions for how use TryParseExtract which is definitely the correct way to go here.
When determining someone's age from their DOB, try using this:
Public Function GetCurrentAge(ByVal dob As Date) As Integer
Dim age As Integer
age = Today.Year - dob.Year
If (dob > Today.AddYears(-age)) Then age -= 1
Return age
End Function
It is the vb version of the top answers on Jeff Atwood's very popular question How do I calculate someone's age
I wrote a blogpost about calculating age from dob as well.
Here's a little different way using the year and month properties of the Date class:
Dim BOD as string
BOD = cbomonth.text + "-" + cboday.text + "-" + txtyear.text
Dim dt As Date
If Date.TryParseExact(BOD, "MMMM-dd-yyyy", Nothing, Globalization.DateTimeStyles.None, dt) Then
Dim Age As New Date(Now.Subtract(dt).Ticks)
MsgBox(String.Format("Your age is : {0} Years and {1} Months", Age.Year - 1, Age.Month - 1))
Else
MsgBox("Birth Date is in wrong format")
End If
Here's a technique when you use Visual Studio 2012
VB.NET language
Private Sub dtpBOfD_ValueChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles dtpBOfD.ValueChanged
lblAge.Text = Age(dtpBOfD.Value)
End Sub
Public Shared Function Age(DOfB As Object) As String
If (Month(Date.Today) * 100) + Date.Today.Day >= (Month(DOfB) * 100) + DOfB.Day Then
Return DateDiff(DateInterval.Year, DOfB, Date.Today)
Else
Return DateDiff(DateInterval.Year, DOfB, Date.Today) - 1
End If
End Function
Use this function
Function String2Date(ByVal sDay As String, ByVal sMonth as String, ByVal sYear as String) As Date
StdDateString = sMonth & " " & sDay & ", " & sYear
End Function
And apply it ..
Dim dt1 as Date = String2Date(ComboBox2.Text,ComboBox1.Text,txtYear.Text).ToShortDateString
Dim dt2 as Date = Now.ToShortDateString
Dim dt3 as TimeSpan = (dt2 - dt1)
Dim diff as Double = dt3.Days
Dim sAge as String
sAge = Str(Int(diff / 365)) & " Year "
diff = diff Mod 365
sAge = sAge & Str(Int(diff / 30)) & " Month(s)"
diff = diff Mod 30
sAge = sAge & Str(diff) & " Day(s)"
txtAge.Text = sAge
for complete age information use this code in c#.`
public string calculateDays(int day, int Month, int year)
{
int Diffyear;
int DiffMonth;
int DiffDay;
int cuYear=DateTime.Now.Year;
int cuMonth=DateTime.Now.Month;
int cuDay=DateTime.Now.Day;
string Age;
Diffyear= cuYear-year;
DiffMonth=cuMonth-Month;
DiffDay=cuDay-day;
if ((DiffMonth) < 0)
{
Diffyear -= 1;
}
if ((DiffDay) < 0)
{
DiffMonth -= 1;
if ((cuMonth - 1) < 8)
{
if (((cuMonth - 1) % 2) == 0)
{
if ((cuMonth - 1) == 2)
if (cuYear % 4 == 0)
{
DiffDay = 29 + DiffDay;
}
else
{
DiffDay = 28 + DiffDay;
}
else
DiffDay = 30 + DiffDay;
}
else
DiffDay = 31 + DiffDay;
}
else
{
if (((cuMonth - 1) % 2) == 0)
{
DiffDay = 31 + DiffDay;
}
else
{
DiffDay = 30 + DiffDay;
}
}
}
if ((DiffMonth) < 0)
{
DiffMonth = DiffMonth+12;
}
if (Diffyear < 0)
{
Diffyear = Diffyear * (-1);
}
if ((DiffDay) < 0)
{
DiffDay = DiffDay * (-1);
}
Age = "Age: " + Diffyear.ToString() + " year, " + DiffMonth.ToString() + " months, " + DiffDay.ToString() + " days";
return Age;
}
`
Dim d1 As Date
Dim d2 As Date
d1 = Format(dob.Value, "yyyy/MM/dd"
d2 = Format(System.DateTime.Now, "yyyy/MM/dd")
d = DateDiff(DateInterval.Year, d1, d2)'d-1 provides accurate age
Related
I have a problem with calculating difference between 2 dates where first is older than second.
For example: I want to find difference between
5.5.2015 and 1.11.2014
I used function
=IF((A(DATEDIF(B12,$W$3,"M")<=12,RANK(Q12,Q:Q)<=11)),Q12;0)
but the function is limited only to situations where the second date is higher than the first one.
I want to know whether B12 is within last 12 months from given date. If it is, then I want to calculate with it.
Is there any way to calculate backwards in excel or VBA?
Thank you.
I know this is an old post already but for anyone who needs this...
Function FindDateDiff(myDate1 As Date, myDate2 As Date) As String
Dim myYears As Long, myMonths As Long, myDays As Long
Dim yearString As String, monthString As String, dayString As String, FinalString As String
If myDate1 > myDate2 Then
myYears = Year(myDate1) - Year(myDate2)
myMonths = Month(myDate1) - Month(myDate2)
myDays = Day(myDate1) - Day(myDate2)
If myDays < 0 Then
myMonths = myMonths - 1
myDays = Day(WorksheetFunction.EoMonth(myDate1, 0)) - Abs(myDays) - 1
End If
Else
myYears = Year(myDate2) - Year(myDate1)
myMonths = Month(myDate2) - Month(myDate1)
myDays = Day(myDate2) - Day(myDate1)
If myDays < 0 Then
myMonths = myMonths - 1
myDays = Day(WorksheetFunction.EoMonth(myDate2, 0)) - Abs(myDays) - 1
End If
End If
If myMonths < 0 Then
myYears = myYears - 1
myMonths = 12 - Abs(myMonths)
End If
If myYears = 0 Then
yearString = ""
ElseIf myYears = 1 Then
yearString = myYears & " year, "
ElseIf myYears > 1 Then
yearString = myYears & " years, "
End If
If myMonths = 0 Then
monthString = ""
ElseIf myMonths = 1 Then
monthString = myMonths & " month, "
ElseIf myMonths > 1 Then
monthString = myMonths & " months, "
End If
If myDays = 0 Then
dayString = ""
ElseIf myDays = 1 Then
dayString = myDays & " day"
ElseIf myDays > 1 Then
dayString = myDays & " days"
End If
FinalString = yearString & monthString & dayString
If Right(FinalString, 2) = ", " Then FinalString = Left(FinalString, Len(FinalString) - 2)
FindDateDiff= FinalString
End Function
Just paste this function in a new module in the workbook and you can start calling this function. '=FindDateDiff(A1,B1)'
This function only require 2 dates as arguments and the order doesn't matter.
I've tested this function with both UK and US format, both works exactly the same.
I used DateDiff before, but the calculation for days and months returns an incorrect value and could be very confuse sometimes.
In VBA use the same function.
NoOfDays = DateDiff("D", DATE1, DATE2)
NoOfDays returns either positive or negative value depending on the dates
I have it solved by using ISERROR
=IF(ISERROR(DATEDIF(RC[-16],R3C23,""M"")<=12),0,RC[-1])
Is it possible to use Format function to display integers in roman numerals?
For Counter As Integer = 1 To 10
Literal1.Text &= Format(Counter, "???")
Next
This is what I found on http://www.source-code.biz/snippets/vbasic/7.htm
(originally written by Mr Christian d'Heureuse in VB)
I converted it to VB.net:
Private Function FormatRoman(ByVal n As Integer) As String
If n = 0 Then FormatRoman = "0" : Exit Function
' there is no Roman symbol for 0, but we don't want to return an empty string
Const r = "IVXLCDM" ' Roman symbols
Dim i As Integer = Math.Abs(n)
Dim s As String = ""
For p As Integer = 1 To 5 Step 2
Dim d As Integer = i Mod 10
i = i \ 10
Select Case d ' format a decimal digit
Case 0 To 3 : s = s.PadLeft(d + Len(s), Mid(r, p, 1))
Case 4 : s = Mid(r, p, 2) & s
Case 5 To 8 : s = Mid(r, p + 1, 1) & s.PadLeft(d - 5 + Len(s), Mid(r, p, 1))
Case 9 : s = Mid(r, p, 1) & Mid(r, p + 2, 1) & s
End Select
Next
s = s.PadLeft(i + Len(s), "M") ' format thousands
If n < 0 Then s = "-" & s ' insert sign if negative (non-standard)
FormatRoman = s
End Function
I hope this will help others.
Cheers - Dave.
No, there is no standard formatter for that.
If you read the Wikipedia on Roman numerals you'll find that there are multiple ways of formatting Roman Numerals. So you will have to write your own method our use the code of someone else.
I wrote this code that works perfectly up to a million.
You can use it but, please, do not make it your own.
Public NotInheritable Class BRoman
'Written by Bernardo Ravazzoni
Public Shared Function hexRoman(ByVal input As Integer) As String
Return mainROMAN(input)
End Function
Private Shared Function mainROMAN(ByVal input As Integer) As String
Dim under As Boolean = udctr(input)
Dim cifretotali As Integer = input.ToString.Length
Dim output As String = ""
Dim remaning As String = input
Dim cifracor As Integer = cifretotali
While Not cifracor = 0
output = output & coreROMAN(division(remaning, remaning), cifracor)
cifracor = cifracor - 1
End While
If under Then
output = "-" & output
End If
Return output
End Function
Private Shared Function coreROMAN(ByVal num As Integer, ByVal pos As Integer) As String
Dim output As String = ""
Debug.WriteLine(num)
Select Case num
Case 1 To 3
output = say(num, getStringFor(True, pos))
Case 4
output = getStringFor(True, pos) & getStringFor(False, pos)
Case 5 To 8
output = getStringFor(False, pos) & say(num - 5, getStringFor(True, pos))
Case 9, 10
output = say(10 - num, getStringFor(True, pos)) & getStringFor(True, pos + 1)
End Select
Return output
End Function
Private Shared Function getStringFor(ByVal first As Boolean, ByVal index As Integer) As String
Dim output As String = ""
index = index * 2
If first Then
index = index - 1
End If
output = rGetStringFor(index)
Return output
End Function
Private Shared Function rGetStringFor(ByVal index As Integer) As String
Dim output As String = ""
Dim sy As Integer
If index < 8 Then
output = rrGetStringFor(index)
Else
sy = index \ 6
output = say(sy, rrGetStringFor(8)) & rrGetStringFor(((index - 2) Mod 6) + 2) & say(sy, rrGetStringFor(9))
End If
Return output
End Function
Private Shared Function rrGetStringFor(ByVal index As Integer) As String
Dim output As String = ""
Select Case index
Case 1
output = "I"
Case 2 '8
output = "V"
Case 3 '9
output = "X"
Case 4 '10
output = "L"
Case 5 '11
output = "C"
Case 6 '12
output = "D"
Case 7 '13
output = "M"
Case 8
output = "["
Case 9
output = "]"
End Select
Return output
End Function
Private Shared Function division(ByVal inputs As String, ByRef resto As String) As Integer
resto = ""
If inputs.Length > 1 Then
resto = inputs.Substring(1)
End If
Dim output As Integer = Integer.Parse(StrReverse(inputs).Substring(inputs.Length - 1))
Return output
End Function
Public Shared Function say(ByVal index As Integer, ByVal letter As String) As String
Dim output As String = ""
While Not index = 0
output = output & letter
index = index - 1
End While
Return output
End Function
Public Shared Function udctr(ByRef num As Integer) As Boolean
Dim und As Boolean = (num < 0)
If und Then
num = 0 - num
End If
Return und
End Function
End Class
Use the function hexRoman, like this example:
msgbox(Broman.hexRoman(50))
Public Class RomanNumber
Public Shared Function FromNumber(val As Byte) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As SByte) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As Int16) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As Int32) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As UInt16) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function FromNumber(val As UInt32) As String
Return GetNumberToRoman(val)
End Function
Public Shared Function ToByte(val As String) As Byte
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToSByte(val As String) As SByte
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToInt16(val As String) As Int16
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToInt32(val As String) As Int32
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToUInt16(val As String) As UInt16
Return GetNumberFromRoman(val)
End Function
Public Shared Function ToUInt32(val As String) As UInt32
Return GetNumberFromRoman(val)
End Function
Private Shared Function GetNumberToRoman(val As Integer) As String
Dim v As String = ""
Do While val > 0
If val >= 1000 Then
v &= "M" : val -= 1000
ElseIf val >= 900 Then
v &= "CM" : val -= 900
ElseIf val >= 500 Then
v &= "D" : val -= 500
ElseIf val >= 400 Then
v &= "CD" : val -= 400
ElseIf val >= 100 Then
v &= "C" : val -= 100
ElseIf val >= 90 Then
v &= "XC" : val -= 90
ElseIf val >= 50 Then
v &= "L" : val -= 50
ElseIf val >= 40 Then
v &= "XL" : val -= 40
ElseIf val >= 10 Then
v &= "X" : val -= 10
ElseIf val >= 9 Then
v &= "IX" : val -= 9
ElseIf val >= 5 Then
v &= "V" : val -= 5
ElseIf val >= 4 Then
v &= "IV" : val -= 4
Else
v &= "I" : val -= 1
End If
Loop
Return v
End Function
Private Shared Function GetNumberFromRoman(val As String) As Object
Dim v As Integer = 0
If val.Contains("IV") Then v += 4 : val = val.Replace("IV", "")
If val.Contains("IX") Then v += 9 : val = val.Replace("IX", "")
If val.Contains("XL") Then v += 40 : val = val.Replace("XL", "")
If val.Contains("XC") Then v += 90 : val = val.Replace("XC", "")
If val.Contains("CD") Then v += 400 : val = val.Replace("CD", "")
If val.Contains("CM") Then v += 900 : val = val.Replace("CM", "")
For Each c As Char In val
If c = "I" Then v += 1
If c = "V" Then v += 5
If c = "X" Then v += 10
If c = "L" Then v += 50
If c = "C" Then v += 100
If c = "D" Then v += 500
If c = "M" Then v += 1000
Next
Return v
End Function
End Class
net coding and i am really stuck in this basic age calculation. I have created a form field and in a groupbox it should display the age of a person. The biggest problem i am facing with the code is factoring in the month. I have tried all types such as using DateInterval.Month but still no luck. Here MyEntPatient.DOB is the DOB of patient
Dim Years As Integer
Dim BDAY As New DateTime(Now.Year)
BDAY = MyEntPatient.DOB
If (BDAY > Now) Then
Years = DateDiff(DateInterval.Year, MyEntPatient.DOB, Now) - 1
Else
Years = DateDiff(DateInterval.Year, MyEntPatient.DOB, Now)
End If
Me.gpxPatientDetails.Text = " Age:" + Years.ToString()
I think you want to have the difference of the date, I think this example help you:
Dim birthday As New DateTime(12, 12, 2012)
Dim difference As DateTime = DateTime.Now - birthday
Dim years As Integer = difference.Years
If you have problem with bigger/smaller age, because someone doesn't have a birthday this year (born in December for example), you can try this:
Dim bday As New DateTime(2010, 1, 25)
Dim months As Integer = DateDiff(DateInterval.Month, bday, Now)
Dim years As Integer = months / 12
Function AgeCalculator(ByVal FromDate As String, Optional flgyearOnly As Boolean = False) As String '23/11/2017
If Not IsDate(FromDate) Then Return ""
Dim tmpYear As String = "", tmpMonth As String = "", tmpdiff As Integer = 0
Dim tmpAge As String = ""
tmpdiff = DateDiff(DateInterval.Day, CDate(Format2DateMMM(FromDate)), Now)
If tmpdiff <= 0 Then Return ""
If tmpdiff > 0 And tmpdiff <= 29 Then
Return tmpdiff & " Days"
End If
If tmpdiff = 30 Then
Return " 1 Month"
End If
tmpYear = tmpdiff / 365
If InStr(tmpYear, ".") > 0 Then
tmpYear = Microsoft.VisualBasic.Left(tmpYear, InStr(tmpYear, ".") - 1)
End If
If Val(tmpYear) = 0 Then tmpYear = ""
If Val(tmpYear) > 0 Then
tmpAge = tmpYear & " years"
If flgyearOnly Then Return tmpAge
End If
tmpdiff = (tmpdiff - (Val(tmpYear) * 365))
tmpMonth = tmpdiff / 30
If InStr(tmpMonth, ".") > 0 Then
tmpMonth = Microsoft.VisualBasic.Left(tmpMonth, InStr(tmpMonth, ".") - 1)
End If
If Val(tmpMonth) = 0 Then tmpMonth = ""
If tmpMonth > 0 Then
tmpAge &= " " & tmpMonth & " Months"
End If
tmpdiff = (tmpdiff - (Val(tmpMonth) * 30))
If Val(tmpdiff) > 0 Then
tmpAge &= " " & tmpdiff & " Days"
End If
Return tmpAge: End Function
A bit old posting, but the question is not!
Typically the 'age' is the whole years completed:
Dim DOB As Date = DateValue("1970-10-28")
Dim Tday As Date = DateValue("2022-02-21")
Console.WriteLine(
Int((CInt(Tday.ToString("yyyyMMdd")) - CInt(DOB.ToString("yyyyMMdd"))) / 10000)
)
mnth = DateDiff(DateInterval.Month, 8/30/2012, 10/1/2012)
gives mnth = 2. But when we look, there is only 32 days between these dates. I am expecting a result mnth=1 as there is only 32 days between these days.
Pls help..
In my scenario i can consider a 15+ days to be a month but if it is less than 15, it should'nt be considered.
To get the number of complete months you can do different things depending on your interpretation,
Public Function CompleteMonthsBetweenA( _
ByVal start As DateTime, _
ByVal end As DateTime) As Integer
Dim invertor = 1
If (start > end) Then
Dim tmp = end
end = start
start = tmp
invertor = -1
End If
Dim diff = ((end.Year - start.Year) * 12) + end.Month - start.Month
If start.Day > end.Day Then
Return (diff - 1) * invertor
Else
Return diff * invertor
End If
End Function
With this function the number of complete months between 31/05/2011 (dd/mm/yy) and 30/06/2011 is 0 but between 30/06/2011 and 31/07/2011 is 1. Which may or may not be what you expect.
Public Function CompleteMonthsBetweenB( _
ByVal start As DateTime, _
ByVal end As DateTime) As Integer
Dim invertor = 1
If (start > end) Then
Dim tmp = end
end = start
start = tmp
invertor = -1
End If
Dim diff = ((end.Year - start.Year) * 12) + end.Month - start.Month
Dim startDaysInMonth = DateTime.DaysInMonth(start.Year, start.Month)
Dim endDaysInMonth = DateTime.DaysInMonth(end.Year, end.Month)
If (start.Day / startDaysInMonth) > (end.Day / endDaysInMonth) Then
Return (diff - 1) * invertor
Else
Return diff * invertor
End If
End Function
With this function the ratio Day / DaysInMonth is taken so the relative completion of the two months can be assessed.
Public Function CompleteMonthsBetweenC( _
ByVal start As DateTime, _
ByVal enddate As DateTime) As Integer
Dim invertor = 1
If (start > enddate) Then
Dim tmp = enddate
enddate = start
start = tmp
invertor = -1
End If
Dim diff = ((enddate.Year - start.Year) * 12) + enddate.Month - start.Month
Dim remainingDays = _
(DateTime.DaysInMonth(start.Year, start.Month) - start.Day) + enddate.Day
If remainingDays < 15 Then
Return (diff - 1) * invertor
Else
Return diff * invertor
End If
End Function
This function only rounds down if the surplus days are less than the magic number 15, which I think is what you are asking for in your update.
Public Function CompleteMonthsBetweenD( _
ByVal start As DateTime, _
ByVal end As DateTime) As Integer
Return end.Subtract(start).TotalDays \ 30.436875
End Function
This function takes the simpler approach of dividing the total number of days by the average number of days per month in the Gregorian Calendar.
The difference in months is calculated without regard to the day component of the dates.
For example, the difference in months between 8/31/2012 and 9/1/2012 is 1, eventhough it's only one day between the dates.
If you want to consider the day component you have to get the date difference in days instead of months, and calculate how many months you want that to be.
This is the class I use (it's C# but really easy to convert to VB.NET).
It is usefull for years, months, days... it is ideal for displaying ages in #Y-#M-#D format.
public class DateDifference
{
/// <summary>
/// defining Number of days in month; index 0=> january and 11=> December
/// february contain either 28 or 29 days, that's why here value is -1
/// which wil be calculate later.
/// </summary>
private int[] monthDay = new int[12] { 31, -1, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 };
/// <summary>
/// contain from date
/// </summary>
private DateTime fromDate;
/// <summary>
/// contain To Date
/// </summary>
private DateTime toDate;
/// <summary>
/// this three variable for output representation..
/// </summary>
private int year;
private int month;
private int day;
public DateDifference(DateTime d1, DateTime d2)
{
int increment;
if (d1 > d2)
{
this.fromDate = d2;
this.toDate = d1;
}
else
{
this.fromDate = d1;
this.toDate = d2;
}
///
/// Day Calculation
///
increment = 0;
if (this.fromDate.Day > this.toDate.Day)
{
increment = this.monthDay[this.fromDate.Month - 1];
}
/// if it is february month
/// if it's to day is less then from day
if (increment == -1)
{
if (DateTime.IsLeapYear(this.fromDate.Year))
{
// leap year february contain 29 days
increment = 29;
}
else
{
increment = 28;
}
}
if (increment != 0)
{
day = (this.toDate.Day + increment) - this.fromDate.Day;
increment = 1;
}
else
{
day = this.toDate.Day - this.fromDate.Day;
}
///
///month calculation
///
if ((this.fromDate.Month + increment) > this.toDate.Month)
{
this.month = (this.toDate.Month + 12) - (this.fromDate.Month + increment);
increment = 1;
}
else
{
this.month = (this.toDate.Month) - (this.fromDate.Month + increment);
increment = 0;
}
///
/// year calculation
///
this.year = this.toDate.Year - (this.fromDate.Year + increment);
}
public override string ToString()
{
//return base.ToString();
return this.year + " Year(s), " + this.month + " month(s), " + this.day + " day(s)";
}
public int Years
{
get
{
return this.year;
}
}
public int Months
{
get
{
return this.month;
}
}
public int Days
{
get
{
return this.day;
}
}
}
USAGE:
DateDifference diff = new DateDifference(date1, date2);
int months = (diff.Years*12) + diff.Months + diff.Days > 15 ? 1 : 0;
If you want the number of complete month, then you'll need to compare date that starts at the begining of the closet month.
Sub Main()
' mnth = DateDiff(DateInterval.Month, 8/30/2012, 10/1/2012)
Console.WriteLine(GetCompleteMonthCount(New DateTime(2012, 8, 30), New DateTime(2012, 10, 1)))
Console.ReadLine()
End Sub
Public Function GetCompleteMonthCount(ByVal d1 As DateTime, ByVal d2 As DateTime) As Integer
If d1.Day <> 1 Then
d1 = d1.AddMonths(1)
d1 = New DateTime(d1.Year, d1.Month, 1)
End If
If d2.Day <> 1 Then
d2 = New DateTime(d2.Year, d2.Month, 1)
End If
Return DateDiff(DateInterval.Month, d1, d2)
End Function
The solutions above are all very good but perhaps a little over-complicated, how about
Function wholeMonthsEd(d1, d2) As Integer
' determine the DateDiff function output
' which gives calendar month difference
initMonths = DateDiff("m", d1, d2)
' do calcs on the Day of the month to deduct/not a calendar month
If Day(d2) < Day(d1) Then
initMonths = initMonths - 1
End If
wholeMonths = initMonths
End Function
I would like to calculate a new date simply by using the build-in dateadd function, but take into account that only weekdays should be counted (or 'business days' so to speak).
I have come up with this simple algorithm, which does not bother about holidays and such. I have tested this with some simple dates, but would like some input if this can be done in better ways.
This sample assumes a week with 5 business days, monday-friday, where first day of the week is monday. Dateformatting used here is d-m-yyyy, the sample calculates with a startdate of october 1, 2009.
Here is the simple form:
Dim d_StartDate As DateTime = "1-10-2009"
Dim i_NumberOfDays As Integer = 12
Dim i_CalculateNumberOfDays As Integer
If i_NumberOfDays > (5 - d_StartDate.DayOfWeek) Then
i_CalculateNumberOfDays = i_NumberOfDays
Else
i_CalculateNumberOfDays = i_NumberOfDays + (Int(((i_NumberOfDays + (7 - d_StartDate.DayOfWeek)) / 5)) * 2)
End If
MsgBox(DateAdd(DateInterval.Day, i_CalculateNumberOfDays, d_StartDate))
Which I try to explain with the following piece of code:
''' create variables to begin with
Dim d_StartDate as Date = "1-10-2009"
Dim i_NumberOfDays as Integer = 5
''' create var to store number of days to calculate with
Dim i_AddNumberOfDays as Integer
''' check if amount of businessdays to add exceeds the
''' amount of businessdays left in the week of the startdate
If i_NumberOfDays > (5 - d_StartDate.DayOfWeek) Then
''' start by substracting days in week with the current day,
''' to calculate the remainder of days left in the current week
i_AddNumberOfDays = 7 - d_StartDate.DayOfWeek
''' add the remainder of days in this week to the total
''' number of days we have to add to the date
i_AddNumberOfDays += i_NumberOfDays
''' divide by 5, because we need to know how many
''' business weeks we are dealing with
i_AddNumberOfDays = i_AddNumberOfDays / 5
''' multiply the integer of current business weeks by 2
''' those are the amount of days in the weekends we have
''' to add to the total
i_AddNumberOfDays = Int(i_AddNumberOfDays) * 2
''' add the number of days to the weekend days
i_AddNumberOfDays += i_NumberOfDays
Else
''' there are enough businessdays left in this week
''' to add the given amount of days
i_AddNumberOfDays = i_NumberOfDays
End If
''' this is the numberof dates to calculate with in DateAdd
dim d_CalculatedDate as Date
d_CalculatedDate = DateAdd(DateInterval.Day, i_AddNumberOfDays, d_StartDate)
Thanks in advance for your comments and input on this.
I used the .DayOfWeek function to check if it was a weekend. This does not include holiday implementation. It has been tested. I realize this question is old but the accepted answer didn't work. However, I did like how clean it was so I thought I'd update it and post. I did change the logic in the while loop.
Function AddBusinessDays(startDate As Date, numberOfDays As Integer) As Date
Dim newDate As Date = startDate
While numberOfDays > 0
newDate = newDate.AddDays(1)
If newDate.DayOfWeek() > 0 AndAlso newDate.DayOfWeek() < 6 Then '1-5 is Mon-Fri
numberOfDays -= 1
End If
End While
Return newDate
End Function
Public Shared Function AddBusinessDays(ByVal startDate As DateTime, _
ByVal businessDays As Integer) As DateTime
Dim di As Integer
Dim calendarDays As Integer
'''di: shift to Friday. If it's Sat or Sun don't shift'
di = (businessDays - Math.Max(0, (5 - startDate.DayOfWeek)))
''' Start = Friday -> add di/5 weeks -> end = Friday'
''' -> if the the remaining (<5 days) is > 0: add it + 2 days (Sat+Sun)'
''' -> shift back to initial day'
calendarDays = ((((di / 5) * 7) _
+ IIf(((di Mod 5) <> 0), (2 + (di Mod 5)), 0)) _
+ (5 - startDate.DayOfWeek))
Return startDate.AddDays(CDbl(calendarDays))
End Function
Your plan seems like it should work. Make sure you wrap it in a function instead of doing out the calculations every place you use it so that if/when you discover you need to account for holidays, you don't have to change it in tons of places.
The best way I can think of for implementing support for holidays would be to add days one at a time in a loop. Each iteration, check if its a weekend or a holiday, and if it is add another day and continue (to skip it). Below is an example in pseudocode (I don't know VB); no guarantees its correct. Of course, you need to provide your own implementations for isWeekend() and isHoliday().
function addBusinessDays(startDate, numDays)
{
Date newDate = startDate;
while (numDays > 0)
{
newDate.addDays(1);
if (newDate.isWeekend() || newDate.isHoliday())
continue;
numDays -= 1;
}
return newDate;
}
My first thought for the holiday thing was to simply look up the number of holidays between the start date and the end date and add that to your calculation, but of course this won't work because the end date is dependent on the number of holidays in that interval. I think an iterative solution is the best you'll get for holidays.
I'm using this code to calculate the date:
dayOfWeek = startDate.DayOfWeek
weekendDays = 2 * Math.Floor((dayOfWeek + businessDays - 0.1) / 5)
newDate = startDate.AddDays(businessDays + weekendDays)
The second line computes the number of full weekends that we have to add and then multiplies them by 2 to obtain the number of days.
The additional -0.1 constant is used to avoid adding days if (dayOfWeek + businessDays) is multiple of 5, and final date is friday.
Private Function AddBusinessDays(ByVal dtStartDate As DateTime, ByVal intVal As Integer) As DateTime
Dim dtTemp As DateTime = dtStartDate
dtTemp = dtStartDate.AddDays(intVal)
Select Case dtTemp.DayOfWeek
Case 0, 6
dtTemp = dtTemp.AddDays(2)
End Select
AddBusinessDays = dtTemp
End Function
please check this code for adding working days
Dim strDate As Date = DateTime.Now.Date
Dim afterAddDays As Date
Dim strResultDate As String
Dim n As Integer = 0
For i = 1 To 15
afterAddDays = strDate.AddDays(i)
If afterAddDays.DayOfWeek = DayOfWeek.Saturday Or afterAddDays.DayOfWeek = DayOfWeek.Sunday Then
n = n + 1
End If
Next
strResultDate = afterAddDays.AddDays(n).ToShortDateString()
Private Function AddXWorkingDays(noOfWorkingDaysToAdd As Integer) As Date
AddXWorkingDays = DateAdd(DateInterval.Weekday, noOfWorkingDaysToAdd + 2, Date.Today)
If Weekday(Today) + noOfWorkingDaysToAdd < 6 Then AddXWorkingDays = DateAdd(DateInterval.Weekday, 2, Date.Today)
End Function
One approach would be to iterate from the start date and add or subtract one day with each iteration if the date is not a Saturday or Sunday. If zero is passed as iAddDays then the function will return dDate even if that date is a Saturday or Sunday. You could play around with the logic to get the outcome you are looking for if that scenario is a possibility.
Public Function DateAddWeekDaysOnly(ByVal dDate As DateTime, ByVal iAddDays As Int32) As DateTime
If iAddDays <> 0 Then
Dim iIncrement As Int32 = If(iAddDays > 0, 1, -1)
Dim iCounter As Int32
Do
dDate = dDate.AddDays(iIncrement)
If dDate.DayOfWeek <> DayOfWeek.Saturday AndAlso dDate.DayOfWeek <> DayOfWeek.Sunday Then iCounter += iIncrement
Loop Until iCounter = iAddDays
End If
Return dDate
End Function
Easy way
function addWerktage($date,$tage){
for($t=0;$t<$tage;$t++){
$date = $date + (60*60*24);
if(date("w",$date) == 0 || date("w",$date) == 6){ $t--; }
}
return $date;
}
This produces the same result as the accepted answer, including starting on weekends, while handling negative offsets and without looping. It's written in c# but should work in any enviroment where numeric weekdays start at Sunday and end at Saturday, and where integer division rounds to 0.
public static DateTime AddWeekdays(DateTime date, int offset)
{
if (offset == 0)
{
return date;
}
// Used to calculate the number of weekend days skipped over
int weekends;
if (offset > 0)
{
if (date.DayOfWeek == DayOfWeek.Saturday)
{
// Monday is 1 weekday away, so it will take an extra day to reach the next weekend
int daysSinceMonday = -1;
// Add two weekends for every five days
int normalWeekends = (offset + daysSinceMonday) / 5 * 2;
// Add one for this Sunday
int partialWeekend = 1;
weekends = normalWeekends + partialWeekend;
}
else
{
// It will take this many fewer days to reach the next weekend.
// Note that this works for Sunday as well (offset -1, same as above)
int daysSinceMonday = date.DayOfWeek - DayOfWeek.Monday;
// Add two weekends for every five days (1 business week)
weekends = (offset + daysSinceMonday) / 5 * 2;
}
}
else
{
// Same as the positive offset case, but counting backwards.
// daysSinceFriday will be 0 or negative, except for Saturday, which is +1
int daysSinceFriday = date.DayOfWeek - DayOfWeek.Friday;
weekends = date.DayOfWeek == DayOfWeek.Sunday
? (offset + 1) / 5 * 2 - 1
: (offset + daysSinceFriday) / 5 * 2;
}
return date.AddDays(offset + weekends);
}
Since the pattern of 2 extra days per 5 days repeats after a full week, you can effectively exhaustively test it:
private static DateTime AddWeekdaysLooping(DateTime date, int offset)
{
DateTime newDate = date;
int step = Math.Sign(offset);
while (offset != 0)
{
newDate = newDate.AddDays(step);
if (newDate.DayOfWeek != DayOfWeek.Sunday && newDate.DayOfWeek != DayOfWeek.Saturday)
{
offset -= step;
}
}
return newDate;
}
void TestWeekdays()
{
DateTime initial = new DateTime(2001, 1, 1);
for (int day = 0; day < 7; day += 1)
{
for (int offset = -25; offset <= 25; offset += 1)
{
DateTime start = initial.AddDays(day);
DateTime expected = AddWeekdaysLooping(start, offset);
DateTime actual = AddWeekdays(start, offset);
if (expected != actual) {
throw new Exception($"{start.DayOfWeek} + {offset}: expected {expected:d}, but got {actual:d}");
}
}
}
}
Dim result As Date
result = DateAdd("d", 2, Today)
If result.DayOfWeek = DayOfWeek.Saturday Then
result = DateAdd("d", 2, result)
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Sunday Then
result = DateAdd("d", 1, result)
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Monday Then
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Tuesday Then
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Wednesday Then
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Thursday Then
MsgBox(result)
ElseIf result.DayOfWeek = DayOfWeek.Friday Then
MsgBox(result)
End If