Mostrar total de suma hh:mm de mas de 24hrs

Hola, muy buenos días!

Ando con un problemilla en el cual espero me puedan ayudar!! Les comento: Estoy haciendo una suma de horas trabajadas, y me parece lo hace bien, pero al superar las 24 hrs se reinicia el acumulador, como hago para que no pasé esto? Les posteo la macro:

Sub horas_trab()
Application.ScreenUpdating = False
Dim nombre(100) As String
Dim id(100) As Integer
Dim h_trab(100) As Date
Dim cad As String
Dim bandera As Boolean
Set h1 = ActiveSheet
n1 = Mid(h1.Name, 9)
bandera = False
fila = 6
i = 1
While Sheets(strnombrehoja$).Cells(fila, 1) Empty
cad = Sheets(strnombrehoja$).Cells(fila, 13)
cad = Format(cad, "hh:mm")
If i = 1 And bandera = False Then
nombre(i) = (Sheets(strnombrehoja$).Cells(fila, 5))
id(i) = (Sheets(strnombrehoja$).Cells(fila, 4))
h_trab(i) = CDate(cad)
bandera = True
Else
If bandera = False Then
m = 1
While bandera = False
If (id(m)) = (Sheets(strnombrehoja$).Cells(fila, 4)) Then
h_trab(m) = CDate(h_trab(m)) + CDate(cad)
bandera = True
Else
If (nombre(m)) = vbNullString Then
nombre(m) = (Sheets(strnombrehoja$).Cells(fila, 5))
id(m) = (Sheets(strnombrehoja$).Cells(fila, 4))
h_trab(m) = CDate(cad)
bandera = True
End If
End If
m = m + 1

Wend

End If
End If
fila = fila + 1
i = i + 1
bandera = False

Wend

k = 7
j = 1
While (nombre(j)) vbNullString
h2.Range("B" & k).Value = id(j)
h2.Range("C" & k).Value = nombre(j)
h2.Range("D" & k).Value = CDate(h_trab(j))
h2.Columns("A:F").EntireColumn.AutoFit
k = k + 1
j = j + 1
Wend

Application.ScreenUpdating = True
End Sub

Desde ya, muchas gracias!