Public Function am_pm(gnrStart As Range, _
                      gnrEnd As Range, _
                      ampm As String) As Double
 
Const am = 400 / 2400   ' ~~ AM is considered from 0400 - 1600
Const pm = 1600 / 2400  ' ~~ PM is considered from 1600 - 0400
Dim amShift As Double, _
    pmShift As Double, _
    timeStart As Double, _
    timeEnd As Double
timeStart = gnrStart.value
  If timeStart >= 1 Then timeStart = timeStart - 1
timeEnd = gnrEnd.value
  If timeEnd >= 1 Then timeEnd = timeEnd - 1
 
'Debug.Print timeStart * 24 & " | " & timeEnd * 24
  Select Case ampm
 
    Case "AM"
      ' ~~ Stop function if both start and end times are within PM range
      If (IsBetween(timeStart, pm, 1, "excl") = True Or IsBetween(timeStart, 0, am, "excl") = True) And _
         (IsBetween(timeEnd, pm, 1, "excl") = True Or IsBetween(timeEnd, 0, am, "excl") = True) Then
        Exit Function
      ' ~~ Start time in AM (between 0400 - 1600)
      ElseIf IsBetween(timeStart, am, pm, "incl") = True Then
        If timeEnd <= pm Then
          am_pm = (Abs(timeEnd - timeStart) + (timeEnd < timeStart)) * 24  ' ~~ If start and end times are within AM block || http://www.cpearson.com/excel/overtime.htm
        ElseIf timeEnd > pm Then
          am_pm = Abs(pm - timeStart) * 24 '  ~~ If start time within AM and end time is past 1600
        End If
      ' ~~ Start time in PM (1600 - 0400) & end time in AM (0400 - 1600)
      ElseIf (IsBetween(timeStart, pm, 1, "incl") = True Or _
              IsBetween(timeStart, 0, am, "incl") = True) And timeEnd >= am Then
            am_pm = Abs(timeEnd - am) * 24 ' ~~ If start time within PM and end time is past 0400
      End If
 
 
    Case "PM"
      ' ~~ Stop function if both start and end times are within AM range
      If IsBetween(timeStart, am, pm, "excl") = True And _
         IsBetween(timeEnd, am, pm, "excl") = True Then
        Exit Function
      ' ~~ Start time in PM (between 1600 - 2359 and 0000 - 0400)
      ElseIf IsBetween(timeStart, pm, 1, "excl") = True Or _
             IsBetween(timeStart, 0, am, "excl") = True Then
        ' ~~ End time in PM (before 0400)
        If timeEnd <= am Then
          am_pm = (timeEnd + Abs(1 - timeStart)) * 24  ' ~~ If start and end times are within PM block (1600 - 0400)
        ElseIf timeEnd > am Then
          If timeStart < am Then
          '  ~~ If start time within PM and end time within AM (past 0400)
            am_pm = Abs(am - timeStart) * 24
          Else
            am_pm = (am + Abs(1 - timeStart)) * 24
          End If
        End If
      ElseIf timeEnd > pm Then
        am_pm = Abs(timeEnd - pm) * 24   ' ~~ If start time within AM (before 1600) and _
                                                   end time within PM (past 1600)
      ElseIf timeStart < am Then
        am_pm = Abs(am - timeStart) * 24 ' ~~ If start time within PM (past 1600) and _
                                                   end time within AM (past 0400)
      End If
  End Select
End Function

Function IsBetween(X, _
                   X1, _
                   X2, _
                   Optional InclExcl = "incl") As Boolean
' ~~ Test if ?X? is between two values, X1 and X2
' http://www.vbaexpress.com/kb/getarticle.php?kb_id=779
     '****************************************************************************************
     '       Title       IsBetween
     '       Target Application:  any
     '       Function;   determines if X is between X1 and X2
     '                    either X1 or X2 can be the min; the other is the max;
     '                       if X1 = X2 and test is inclusive, IsBetween will be true IFF
     '                           X = X1 = X2
     '                       if X1 = X2 and test is exclusive, IsBetween is always False
     '       Passed Values:
     '           X       [in, numeric]
     '           X1      [in, numeric]   one side of test
     '           X2      [in, numeric]   other side of test
     '           InclExcl  [in, string, optioal] Inclusive or Exclusive flag
     '
     '****************************************************************************************
Dim Xmax
Dim Xmin
  ' detmine min and max values
  If X1 <= X2 Then
    Xmin = X1
    Xmax = X2
  Else
    Xmin = X2
    Xmax = X1
  End If
 
  Select Case LCase(InclExcl)
    Case "incl" ' test includes both X1 and X2:    Xmin <= X <= Xmax
      If X >= Xmin And X <= Xmax Then
        IsBetween = True
      Else
        IsBetween = False
      End If
 
    Case "excl" ' test excludes both X1 and X2:    Xmin < X < Xmax
      If X > Xmin And X < Xmax Then
        IsBetween = True
      Else
        IsBetween = False
      End If
    Case Else
      MsgBox "bad call to IsBetween"
  End Select
 
End Function