View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
swiftcode swiftcode is offline
external usenet poster
 
Posts: 36
Default Date input to exclude weekends

Hi all,

Thank you very much for your help on this. Using a combination of your ideas
and solutions, i have found a solution to my problem. I know it may not be
the most efficient, however, this seems to work, it would be great if anyone
could help me to shorten and make the coding more efficient.

----------------------------------------------------------------------------
Function SetDate(Current_Date, Holiday_Adjustment)

Dim SDate As Date

HAdj = Val(Replace(Holiday_Adjustment, "T", ""))
SDate = Current_Date

If (HAdj = "" Or HAdj = 0) And Weekday(SDate) = 1 Then
SDate = SDate + 1
ElseIf (HAdj = "" Or HAdj = 0) And Weekday(SDate) = 7 Then
SDate = SDate + 2
ElseIf HAdj = 1 And Weekday(SDate) = 2 Then
SDate = SDate + 1
ElseIf HAdj = 1 And Weekday(SDate) = 3 Then
SDate = SDate + 1
ElseIf HAdj = 1 And Weekday(SDate) = 4 Then
SDate = SDate + 1
ElseIf HAdj = 1 And Weekday(SDate) = 5 Then
SDate = SDate + 1
ElseIf HAdj = 1 And Weekday(SDate) = 6 Then
SDate = SDate + 3
ElseIf HAdj = 1 And Weekday(SDate) = 7 Then
SDate = SDate + 2
ElseIf HAdj = 1 And Weekday(SDate) = 1 Then
SDate = SDate + 1

ElseIf HAdj = 2 And Weekday(SDate) = 2 Then
SDate = SDate + 2
ElseIf HAdj = 2 And Weekday(SDate) = 3 Then
SDate = SDate + 2
ElseIf HAdj = 2 And Weekday(SDate) = 4 Then
SDate = SDate + 2
ElseIf HAdj = 2 And Weekday(SDate) = 5 Then
SDate = SDate + 4
ElseIf HAdj = 2 And Weekday(SDate) = 6 Then
SDate = SDate + 4
ElseIf HAdj = 2 And Weekday(SDate) = 7 Then
SDate = SDate + 3
ElseIf HAdj = 2 And Weekday(SDate) = 1 Then
SDate = SDate + 2

ElseIf HAdj = 3 And Weekday(SDate) = 2 Then
SDate = SDate + 3
ElseIf HAdj = 3 And Weekday(SDate) = 3 Then
SDate = SDate + 3
ElseIf HAdj = 3 And Weekday(SDate) = 4 Then
SDate = SDate + 5
ElseIf HAdj = 3 And Weekday(SDate) = 5 Then
SDate = SDate + 5
ElseIf HAdj = 3 And Weekday(SDate) = 6 Then
SDate = SDate + 5
ElseIf HAdj = 3 And Weekday(SDate) = 7 Then
SDate = SDate + 4
ElseIf HAdj = 3 And Weekday(SDate) = 1 Then
SDate = SDate + 3
End If

SetDate = SDate

End Function
---------------------------------------------------------------------------

Many thanks to everyone for all the help given here.

Rgds
Ray

"Ron Rosenfeld" wrote:

On Sun, 11 Oct 2009 20:54:01 -0700, swiftcode
wrote:

Hi all,

I seem to have a problem with making my dates auto adjust itself. Here's
what the problem is. I would like to have a date whereby if it is falls on a
weekend to auto adjust itself to monday, but if i have a holiday adjustment,
then to take into account the number of holidays and adjust accordingly. This
is what i've doe so fat bu it doesn't seem to work.

Function SetDate(Current_Date, Holiday_Adjustment)

If Holiday_Adjustment = "T" Then
Date_Adj = 0
ElseIf Holiday_Adjustment = "T + 1" Then
Date_Adj = 1
ElseIf Holiday_Adjustment = "T + 2" Then
Date_Adj = 2
ElseIf Holiday_Adjustment = "T + 3" Then
Date_Adj = 3
End If

WeekDayNum = Weekday(Current_Date)

If WeekDayNum = 2 Then
Date_Adj1 = 0
ElseIf WeekDayNum = 3 Then
Date_Adj1 = 0
ElseIf WeekDayNum = 4 Then
Date_Adj1 = 0
ElseIf WeekDayNum = 5 Then
Date_Adj1 = 0
ElseIf WeekDayNum = 6 Then
Date_Adj1 = 0
ElseIf WeekDayNum = 7 Then
Date_Adj1 = 2
ElseIf WeekDayNum = 1 Then
Date_Adj1 = 1
End If

SetDate = Current_Date + Date_Adj + Date_Adj1

End Function

I would appreciate any help that anyone can give. Thank you in advance.

Rgds
Ray


Why not just use the WORKDAY function? If you have a version of Excel prior to
2007, you will need to install the analysis toolpak.

Then you could have a list of holidays someplace, and merely input that range
or array as an argument.

For example, with a list of holidays in a range named "Holidays", you could use
any of the following:

With date to be "adjusted" in A1:
=WORKDAY(A1-1,1,Holidays)

VBA variant for Excel 2007:

Function SetDate(Current_Date As Date, Holidays As Range) As Date
SetDate = WorksheetFunction.WorkDay(Current_Date - 1, 1, Holidays)
End Function

For versions of Excel prior to 2007, I believe you have to set a reference to
atpvbaen.xls (under the main menu for VBA, see Tools/References), and then you
can use the command directly.

If, for some reason, you don't want to use the builtin WORKDAY function, you
could use this:

==========================
Option Explicit
Function SetDate(Current_Date As Date, Holidays As Range) As Date
Dim i As Long
Dim TempDate As Date
Dim c As Range
Dim Stp As Integer
Const NumDays As Long = 1

Stp = Sgn(NumDays)
TempDate = Current_Date - 1
For i = Stp To NumDays Step Stp
TempDate = TempDate + Stp
If Weekday(TempDate) = vbSaturday Then _
TempDate = TempDate + Stp - (Stp 0)
If Weekday(TempDate) = vbSunday Then _
TempDate = TempDate + Stp + (Stp < 0)

If Not Holidays Is Nothing Then
Do Until Not IsError(Application.Match(CDbl(TempDate), Holidays, 0)) = False
If IsError(Application.Match(CDbl(TempDate), Holidays, 0)) = False Then
TempDate = TempDate + Stp
If Weekday(TempDate) = vbSaturday Then _
TempDate = TempDate + Stp - (Stp 0)
If Weekday(TempDate) = vbSunday Then _
TempDate = TempDate + Stp + (Stp < 0)
End If
Loop
End If
Next i
SetDate = TempDate
End Function
=====================================
--ron