Function: Count Weekday Hours (VBA (All))

Topic

New Reply

Greetings everyone!

I’m pulling a Chris Greaves here (i.e. posting code just for FUN ).

I’ve recently written a function to calculate the number of hours from StartTime on StartDate to StopTime on StopDate. Not a problem. Here’s the catch – leave out the weekend hours. I’ve included two constants for the official StopTime on Friday (afternoon or evening) and the StartTime on Monday – these, of course, can be adjutsed.

Please feel free to borrow this if you happen to find it useful. Also, if anyone has any complaints or suggestions, please feel free to speak up!

Best regards!

(Code follows):

Public Function CountWeekdayHours(StartDate As Date, StopDate As Date, _
  StartTime As Date, StopTime As Date) As Integer
  'By: Mark Johnston 7/9/2001 Mark@JohnstonData.com
  '     http://JohnstonData.com
  'Inputs: StartDate and StopDate as Dates,
  '   StartTime and StopTime as Dates (time format).
  '   StartDate and StopDate MUST be weekdays, otherwise
  '   the function returns 0!
  'Returns: Integer with counted number of hours between
  '   StartTime on StartDate and StopTime on StopDate
  '   excluding weekend hours.
  '   Use FridayStopTime and MondayStartTime Constants
  '   to set the weekend times.
  
  '====================================
  'Change these as needed
  '------------------------------------
  Const FridayStopTime = #8:00:00 PM#
  Const MondayStartTime = #8:00:00 AM#
  '====================================
  
  Dim dteCounter As Date
  Dim intCounter As Integer
  Dim intWeekends As Integer
  Dim intWeekendHours As Integer
  
  If Weekday(StartDate) = 1 Or Weekday(StartDate) = 7 _
    Or Weekday(StopDate) = 1 Or Weekday(StopDate) = 7 Then
      'If StartDate or StopDate is Saturday or Sunday,
      'Function returns 0
      CountWeekdayHours = 0
  Else
    If (Weekday(StartDate) = 6 And StartTime > FridayStopTime) _
      Or (Weekday(StopDate) = 6 And StopTime > FridayStopTime) _
      Or (Weekday(StartDate) = 2 And StartTime < MondayStartTime) _
      Or (Weekday(StopDate) = 2 And StopTime < MondayStartTime) Then
      'If StartDate is Friday and StarTime is after FridayStopTime
      'OR StopDate is Friday and StopTime is after FridayStopTime
      'OR StartDate is Monday and StartTime is before MondayStartTime
      'OR StopDate is Monday and StopTime is before MondayStartTime
      'Function returns 0
      CountWeekdayHours = 0
    Else
      'Get down to business!
      dteCounter = StartDate
      intCounter = 0
      intWeekends = 0
      
      'Add 24 hours per Weekday (regardless of StartTime or StopTime)
      'Use 1 day AFTER StopDate (hours will be subtracted later)
      Do Until dteCounter = StopDate
        Select Case Weekday(dteCounter)
          Case 1 To 5, 7 'Monday through Thursday
            intCounter = intCounter + 24
            dteCounter = DateAdd("d", 1, dteCounter)
          Case 6 'Friday
            intCounter = intCounter + 24
            If Not StopDate = dteCounter Then
              intWeekends = intWeekends + 1
            End If
            dteCounter = DateAdd("d", 1, dteCounter)
        End Select
      Loop
      
      'Calculate total weekend hours based on FridayStopTime and MondayStartTime
      intWeekendHours = 48 'Saturday and Sunday
      'Add post-FridayStopTime hours
      intWeekendHours = intWeekendHours + 24 _
            - DateDiff("h", #12:00:00 AM#, FridayStopTime)
      'Add pre-MondayStartTime hours
      intWeekendHours = intWeekendHours _
            + DateDiff("h", #12:00:00 AM#, MondayStartTime)
      
      'Subtract TOTAL Weekend hours from intCounter
      intCounter = intCounter - (intWeekendHours * intWeekends)
      
      'Subtract excess hours before StartTime and after StopTime
      intCounter = intCounter - (DateDiff("h", #12:00:00 AM#, StartTime) _
            + DateDiff("h", StopTime, #12:00:00 AM#))
      
      'Finish
      CountWeekdayHours = intCounter
      
    End If
  End If
End Function

Reply | Quote