VBA ignore weekends and holidays.

[MaikkiD]

Hi all,

I am in charge of doing Turn Around Time reports, I have made a macro to extract the data, but it's not at all flexible, we have several products that have different turn around times, so for each turn around time I have a seperate bit of code that's slightly different. If a products turn around time changes then I have to change the code as well, I am wanting to have it so I can use the same code regardless of the turn around time...

The turn around time only includes weekdays, not weekends or holidays. So if it's a two day turn around, and today is Monday, then it's anything ordered on Thursday or before that should be on the report.
I am hoping to find a way to have it, so if I say "Turn around time: 3 days", it will count back ignoring weekends and hoidays.

Currently I have this for a two day turn around:
[vba]Function TodaysTATPF(x As Integer)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sheetRange As String
Call BankHolidays
firstRow = 2
lastRow = Range("A" & Rows.Count).End(xlUp).Row
sheetRange = "A" & firstRow & ":U" & lastRow
If Date >= SpringBHStart And Date <= SpringBHEnd Or Date >= SummerBHStart And _
Date <= SummerBHEnd Or Date >= MayBHStart And Date <= MayBHEnd Then
If Weekday(Now()) = vbTuesday Or Weekday(Now()) = vbWednesday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 3)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
ElseIf Date >= EasterStart And Date <= EasterEnd Then
If Weekday(Now()) = vbTuesday Or Weekday(Now()) = vbWednesday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 4)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
ElseIf Weekday(Now()) = vbMonday Or Weekday(Now()) = vbTuesday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 2)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
End Function[/vba]

And here's what I do for a three day turn around time

[vba]Function TodaysTATTC(x As Integer)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sheetRange As String
Call BankHolidays
firstRow = 2
lastRow = Range("A" & Rows.Count).End(xlUp).Row
sheetRange = "A" & firstRow & ":U" & lastRow
If Date >= SpringBHStart And Date <= SpringBHEnd Or Date >= SummerBHStart And _
Date <= SummerBHEnd Or Date >= MayBHStart And Date <= MayBHEnd Then
If Weekday(Now()) = vbTuesday Or Weekday(Now()) = vbWednesday Or Weekday(Now()) = vbThursday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 3)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
ElseIf Date >= EasterStart And Date <= EasterEnd Then
If Weekday(Now()) = vbTuesday Or Weekday(Now()) = vbWednesday Or Weekday(Now()) = vbThursday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 4)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
ElseIf Weekday(Now()) = vbMonday Or Weekday(Now()) = vbTuesday Or Weekday(Now()) = vbWednesday Then
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x - 2)), _
Operator:=xlAnd
Else
ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - x)), _
Operator:=xlAnd
End If
End Function[/vba]

So there are just slight differences which I have to make to account for the weekend.. But there are several other products that have different turn around times as well.

If someone could atleast give me a little idea of where to start, that would be awesome.

Thanks a lot.

[SamT]

Refactor your code to remove all day counting bits and just leave the Cell manipulating bits. You'll have to play with Holidays and weekends in the Function ActualTurnAroundDays to get them to add correctly

OOps! Typo. ProductTurnAroudDays should read ProductTurnAroundDays
[vba]Sub SamT(ProductTurnAroudDays As Long)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sheetRange As String
Dim TA_Days As Long

TA_Days = ActualTurnAroundDays(ProductTurnAroudDays)

ActiveSheet.Range(sheetRange).AutoFilter Field:=6, Criteria1:=">=" & CLng(DateSerial(Year(Date), Month(Date), Day(Date) - TA_Days)), _
Operator:=xlAnd
End Sub[/vba]

Here's the function(s) used to set TA_Days.
[vba]Function ActualTurnAroundDays(ProductTurnAroudDays As Long) As Long
Dim ExtraDays As Long
ExtraDays = NumWkEnds(ProductTurnAroudDays)
ExtraDays = ExtraDays + NumHolidays(ProductTurnAroudDays)
ActualTurnAroundDays = ExtraDays
End Function

Function NumHolidays(ProductTurnAroudDays As Integer) As Long
ProductTurnAroudDays '= Code to determine number of holidays between Now and NOW - ProductTurnAroudDays
End Function

Function NumWkEnds(ProductTurnAroudDays As Integer) As Long
NumWkEnds '= Code to count number of weekend days betweeen Now and Now - ProductTurnAroudDays
End Function
[/vba]