Effective Days function in VBA

[M@N]

Hi all,

I am after a piece of coding to incorporate into a user defined function as follows:

=UDF(start_date , finish_date , [1 or 2 or 3] , 'range of public holiday dates')

1 = calendar days (i.e. finish_date - start_date)
2 = business days (i.e. finish_date - start_date, less weekends and public holidays)
3 = working days (i.e. finish_date - start_date, less Sundays and public holidays)

This is similar to the 'NETWORKDAYS.INTL' standard function, however I cannot use that for two reasons; first the standard 'NETWORKDAYS.INTL' function does not calculate calendar days, and second I need the coding to be part of a larger user defined function that already has a start_date and finish_date field in it.

Any help would be appreciated.

Thanks.

[karedog]

Maybe :

Public Function EffectiveDays(startDate As Date, finishDate As Date, method As Long, Optional rngHoliday)
  Dim d1 As Date, d2 As Date, d As Long, i As Long, v As Variant
  d1 = Int(startDate): d2 = Int(finishDate)
  If d1 > d2 Then: v = d1: d1 = d2: d2 = v
  d = DateDiff("d", d1, d2) + 1
  Select Case method
    Case 2
      For i = CLng(d1) To CLng(d2)
          If (i Mod 7 = 0) Or (i Mod 7 = 1) Then d = d - 1
      Next i
    Case 3
      For i = CLng(d1) To CLng(d2)
          If (i Mod 7 = 1) Then d = d - 1
      Next i
  End Select
  If Not IsMissing(rngHoliday) Then
     For Each v In rngHoliday
         If IsDate(v) Then
            i = Int(v)
            If i >= d1 And i <= d2 Then d = d - 1
         End If
     Next v
  End If
  EffectiveDays = d
End Function

[Crooza]

Here's another version

Just check that Karedogs version doesn't count public holidays that also fall on a weekend. These need to be excluded from the count as they overlap.

Function workdays(date1 As Date, date2 As Date, switch As Single, pubhols As Range) As Single
Dim cell As Range
Dim count, weekends As Single
count = 0
weekends = 0

If switch = 1 Then
    result = date2 - date1 + 1
End If

If switch = 2 Then
    For i = date1 To date2
        If WorksheetFunction.Weekday(i, 16) < 3 Then 'counts the weekends
        weekends = weekends + 1
        End If
    Next i
    result = date2 - date1 + 1 - weekends
End If

If switch = 3 Then

For i = date1 To date2
        If WorksheetFunction.Weekday(i, 16) < 3 Then 'counts the weekends
        weekends = weekends + 1
        End If
    Next i

For Each cell In pubhols
    If cell.Value >= date1 And cell.Value <= date2 And WorksheetFunction.Weekday(cell.Value, 16) > 2 Then
        count = count + 1 ' a pub holiday that doesn't fall on a weekend
    End If
 Next cell
    result = date2 - date1 + 1 - count - weekends
End If


workdays = result


End Function

[Crooza]

And here's the file with the UDF

[karedog]

Good catch Crooza, I miss that point.

Fixed UDF :

Public Function EffectiveDays(startDate As Date, finishDate As Date, method As Long, Optional rngHoliday)
  Dim d1 As Date, d2 As Date, d As Long, i As Long, v As Variant
  d1 = Int(startDate): d2 = Int(finishDate)
  If d1 > d2 Then: v = d1: d1 = d2: d2 = v
  d = DateDiff("d", d1, d2) + 1
  Select Case method
    Case 2
      For i = CLng(d1) To CLng(d2)
          If (i Mod 7 = 0) Or (i Mod 7 = 1) Then d = d - 1
      Next i
    Case 3
      For i = CLng(d1) To CLng(d2)
          If (i Mod 7 = 1) Then d = d - 1
      Next i
  End Select
  If Not IsMissing(rngHoliday) Then
     For Each v In rngHoliday
         If IsDate(v) Then
            i = Int(v)
            If i >= d1 And i <= d2 Then
               Select Case method
                 Case 2
                   If (i Mod 7 <> 0) And (i Mod 7 <> 1) Then d = d - 1
                 Case 3
                   If (i Mod 7 <> 1) Then d = d - 1
               End Select
            End If
         End If
     Next v
  End If
  EffectiveDays = d
End Function

[M@N]

Karedog /Crooza, thank you both. Works a treat!

[Crooza]

Great. Glad it works how you wanted

[karedog]

You are welcome M@N, thanks for the rep. points and marking the thread as solved.


Regards