trying to get date return without weekends... help please

[kobie]

Hi everyone! I havent had to use th forum in a whhile but here-goes:

I am creating a dropdown to dictate a return date. Here is my code:

Private Sub cboSelectAttempts_Change()
If cboSelectAttempts.ListIndex = 0 Then
txtFlup.Text = "Waiting"
cboSelectAttempts.SetFocus
End If


If cboSelectAttempts.ListIndex = 1 Then
txtFlup.Text = Format(Now + 4, "mm/dd/yyyy")
txtBtn.SetFocus
End If



If cboSelectAttempts.ListIndex = 2 Then
txtFlup.Text = Format(Now + 3, "mm/dd/yyyy")
txtBtn.SetFocus
End If



If cboSelectAttempts.ListIndex = 3 Then
txtFlup.Text = Format(Now + 2, "mm/dd/yyyy")
txtBtn.SetFocus
End If



If cboSelectAttempts.ListIndex = 4 Then
txtFlup.Text = Format(Now + 1, "mm/dd/yyyy")
txtBtn.SetFocus
End If



If cboSelectAttempts.ListIndex = 5 Then
txtFlup.Text = Format(Now + 1, "mm/dd/yyyy")
txtBtn.SetFocus
End If

End Sub

I am wanting "txtFlup.Text" to return the date specified but i want to exclude weekends.

Anyone's help is appreciated!!

Thanks

Kobie

[MacroShadow]

What would like to happen if a returned date is a weekend?

[kobie]

If a weekend(day) is included, I would like to remove Saturday and Sunday in the total number of days incremented. So if:

If cboSelectAttempts.ListIndex = 1 Then
txtFlup.Text = Format(Date + 4, "mm/dd/yyyy")
txtBtn.SetFocus
End If

03/29/2012 + 4, I want it to show: 04/04/2012

Bryan





What would like to happen if a returned date is a weekend?

[MacroShadow]

Copy the following code to a module:

' Source: http://access.mvps.org/access/datetime/date0012.htm
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.


Public Function dhAddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
' Add the specified number of work days to the
' specified date.

' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' In:
' lngDays:
' Number of work days to add to the start date.
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value, if that's what you want.
' Out:
' Return Value:
' The date of the working day lngDays from the start, taking
' into account weekends and holidays.
' Example:
' dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#))
' returns #2/25/2000#, which is the date 10 work days
' after 2/9/2000, if you treat 2/16 and 2/17 as holidays
' (just made-up holidays, for example purposes only).

' Did the caller pass in a date? If not, use
' the current date.
Dim lngCount As Long
Dim dtmTemp As Date

If dtmDate = 0 Then
dtmDate = Date
End If

dtmTemp = dtmDate
For lngCount = 1 To lngDays
dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates)
Next lngCount
dhAddWorkDaysA = dtmTemp
End Function

Public Function dhNextWorkdayA( _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant = Empty) As Date

' Return the next working day after the specified date.

' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Requires:
' SkipHolidays
' IsWeekend

' In:
' dtmDate:
' date on which to start looking.
' Use the current date, if none was specified.
' adtmDates (Optional):
' Array containing holiday dates. Can also be a single
' date value.
' Out:
' Return Value:
' The date of the next working day, taking
' into account weekends and holidays.
' Example:
' ' Find the next working date after 5/30/97
' dtmDate = dhNextWorkdayA(#5/23/1997#, #5/26/97#)
' ' dtmDate should be 5/27/97, because 5/26/97 is Memorial day.

' Did the caller pass in a date? If not, use
' the current date.
If dtmDate = 0 Then
dtmDate = Date
End If

dhNextWorkdayA = SkipHolidaysA(adtmDates, dtmDate + 1, 1)
End Function

Private Function FindItemInArray(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long

On Error GoTo HandleErrors

For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
FindItemInArray = True
GoTo ExitHere
End If
Next lngItem

ExitHere:
Exit Function

HandleErrors:
' Do nothing at all.
' Return False.
Resume ExitHere
End Function

Private Function IsWeekend(dtmTemp As Variant) As Boolean
' If your weekends aren't Saturday (day 7) and Sunday (day 1),
' change this routine to return True for whatever days
' you DO treat as weekend days.

' Modified from code in "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Required by:
' SkipHolidays
' dhFirstWorkdayInMonth
' dbLastWorkdayInMonth
' dhNextWorkday
' dhPreviousWorkday
' dhCountWorkdays

If VarType(dtmTemp) = vbDate Then
Select Case Weekday(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End If
End Function

Private Function SkipHolidaysA( _
adtmDates As Variant, _
dtmTemp As Date, intIncrement As Integer) As Date
' Skip weekend days, and holidays in the array referred to by adtmDates.
' Return dtmTemp + as many days as it takes to get to a day that's not
' a holiday or weekend.

' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.

' Required by:
' dhFirstWorkdayInMonthA
' dbLastWorkdayInMonthA
' dhNextWorkdayA
' dhPreviousWorkdayA
' dhCountWorkdaysA

' Requires:
' IsWeekend

Dim strCriteria As String
Dim strFieldName As String
Dim lngItem As Long
Dim blnFound As Boolean

On Error GoTo HandleErrors

' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless adtmDates an item for every day in the year (!)
' this should finally converge on a weekday.

Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnFound = FindItemInArray(dtmTemp, adtmDates)
If blnFound Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnFound
Case vbDate
If dtmTemp = adtmDates Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not IsWeekend(dtmTemp)

ExitHere:
SkipHolidaysA = dtmTemp
Exit Function

HandleErrors:
' No matter what the error, just
' return without complaining.
' The worst that could happen is that we
' include a holiday as a real day, even if
' it's in the array.
Resume ExitHere
End Function

And change your code so:

Private Sub cboSelectAttempts_Change()

If cboSelectAttempts.ListIndex = 0 Then
txtFlup.Text = "Waiting"
cboSelectAttempts.SetFocus
End If

If cboSelectAttempts.ListIndex = 1 Then
txtFlup.Text = Format(dhAddWorkDaysA(4, Date), "mm/dd/yyyy")
txtBtn.SetFocus
End If

If cboSelectAttempts.ListIndex = 2 Then
txtFlup.Text = Format(dhAddWorkDaysA(3, Date), "mm/dd/yyyy")
txtBtn.SetFocus
End If

If cboSelectAttempts.ListIndex = 3 Then
txtFlup.Text = Format(dhAddWorkDaysA(2, Date), "mm/dd/yyyy")
txtBtn.SetFocus
End If

If cboSelectAttempts.ListIndex = 4 Then
txtFlup.Text = Format(dhAddWorkDaysA(1, Date), "mm/dd/yyyy")
txtBtn.SetFocus
End If

If cboSelectAttempts.ListIndex = 5 Then
txtFlup.Text = Format(dhAddWorkDaysA(1, Date), "mm/dd/yyyy")
txtBtn.SetFocus
End If

End Sub
I haven't tested it so let me know if it works.

[macropod]

Cross-posted at: http://www.mrexcel.com/forum/showthread.php?p=3100448 (http://www.mrexcel.com/forum/showthread.php?p=3100448)
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184