Como desglosar turno en horas diurnas y horas nocturnas

Necesito ayuda quiero un algoritmo o función que devuelva o desglose las horas diurnas y las horas nocturnas el horario nocturno es de 22:00 a 6:00, tengo el siguiente código:

Dim he, hs As Variant
he = Format(Text1, "hh:mm")
hs = Format(Text2, "hh:mm")
If TimeValue(he) < TimeValue(hs) And TimeValue(he) < #10:00:00 PM# And TimeValue(hs) <= #10:00:00 PM# Then
    hd = TimeValue(he) - TimeValue(hs)
    hn = "00:00"
    Debug.Print "menor"
ElseIf TimeValue(he) < #10:00:00 PM# And TimeValue(hs) > #10:00:00 PM# And TimeValue(hs) <= #6:00:00 AM# Then
    hd = TimeValue(he) - #10:00:00 PM#
    hn = TimeValue(hs) + 1 - #10:00:00 PM#
    Debug.Print hn
    If hn > 0.333333333333334 Then
        MsgBox "Revise el turno, las horas nocturnas no puede sobrepasar las 8 horas"
        Text2.SetFocus
    End If
Else
    hd = #10:00:00 PM# - TimeValue(he)
    hn = TimeValue(hs) + 1 - #10:00:00 PM#
    Debug.Print hn
    If hn > 0.333333333333334 Then
        MsgBox "Revise el turno, las horas nocturnas no puede sobrepasar las 8 horas"
        Text2.SetFocus
    End If
End If
Label3 = Format(hd, "hh:mm")
Label4 = Format(hn, "hh:mm")
Label8 = Format(hds, "hh:mm")