PDA

View Full Version : Populate the text2 box with the expiration date of 30 working days



bittu2016
02-19-2017, 09:52 AM
Hi all,
I am trying to find the logic / function for the date .

Ex: I have 2 text boxes in a form and want to Populate the text2 box with the expiration date of 60 working days from the date in text1 box
Text1 box = '21-02-2017'
then
Text2 = '29-Apr-2017' (text1 box + 60 days - holidays )


I want to exclude (sat, sun, holidays in these 60 days)

* holiday date : 01-Apr-2017

could anyone can help me


Thanks
Bittu

SamT
02-19-2017, 01:39 PM
Form Control Values are text strings

Dim strtDate as Date
StrtDate = CDate(TextBox1.Text)

60 weekdays is 12 weeks or 84 calendar days.To find that date

Dim TmpEndDate As Date
TmpEndDate = DateAdd("d", (60/5) * 7 , strtDate)

Now you will need a list of holidays to refer to. HDayList

Dim HDayCount as Long
Dim HDayList As Range
Set HDayList = 'Set HDayList as needed

For Each Cel in HDayList
IF Cdate(Cel) >= strtDate And Cdate(Cel) <= tmpEndDate + HDaysCount Then HDaysCount = HDaysCount + 1
Next

tmpEndDate + HDaysCount accounts for the fact that each holiday extends the end date.

Now we have to count the weekends between tmpEndDate and tmpEndDate + HDaysCount.It's easiest to use another temporary date variable in this loop

Dim TDate As Date
Tdate = tmpEndDate

Do while TDate <= tmpEndDate + HDaysCount
'Double check the math logic in this loop
If WeekDay(Tdate) = 1 Or WeekDay(Tdate) = 7 then HDaysCount = HDaysCount + 1
TDate = Tdate + 1
Loop

SamT
02-19-2017, 01:58 PM
Puttoing it all together as a function

Option Explicit

Function AddWorkDaysDate(DaysToAdd As Long, StartDate As String) As String
Dim strtDate As Date
Dim TmpEndDate As Date
Dim HDaysCount As Long
Dim HDayList As Range
Dim TDate As Date
Dim Cel As Range

strtDate = CDate(StartDate)
TmpEndDate = DateAdd("d", (DaysToAdd / 5) * 7, strtDate)
Set HDayList = Sheet1.Cells(1)

For Each Cel In HDayList
If CDate(Cel) >= strtDate And CDate(Cel) <= TmpEndDate + HDaysCount Then HDaysCount = HDaysCount + 1
Next

TDate = TmpEndDate

Do While TDate <= TmpEndDate + HDaysCount
'Double check the math logic in this loop
If Weekday(TDate) = 1 Or Weekday(TDate) = 7 Then HDaysCount = HDaysCount + 1
TDate = TDate + 1
Loop

AddWorkDaysDate = Format(TmpEndDate + HDaysCount, "dd - mmm - yyyy")

End Function

The result I got with that function was 17 May, 2017

Sub Test_AddWorkDaysDate()
Dim X
X = AddWorkDaysDate(60, "21-02-2017")
End Sub

You can use this Function with

TextBox2.Text = AddWorkDaysDate(60, TextBox1.Value)