compare 2 dates and give the date conditions are met

[chin_un_len]

I run a macro that basically compares the time beetween two dates and if
two conditions are met, colors the backgorund either Yellow or Red.
the code inserts a column and pastes the time difference on it then it
colors the background, the time difference is given in Decimal, I would
like to change the code so that when the conditions are met it gives the
date when the condition was met.
For example it requires to compare a ticket that was created on
06/02/2006 14:07 and if between 96 hours to 120 hours have passed then
color yellow, or if more than 120 hours have passed then color Red, the
change I would like to make is that instead of giving the total time
passed since creation to system date in decimal, it gives the date and
time when the 96 or 120 hours happened, in this case the 120 hours
would have fallen sometime on 10/02/2006, that is the date I would like
to see pasted and background colored. The code uses networkdays so that
only weekdays are included for Medium and High, Top does include
weekends 24/7.
The code uses Column E looking for keywords Medium, High and Top, uses
column H which is date created and inserts column I, where the time is
pasted and colored.
Any help will be much appreciated.

Below is the code used:


Code:
--------------------
Dim ws1 As Worksheet
Dim r As Long, lastrow As Long

Set ws1 = Worksheets("Currently Open Report")
With ws1

Columns("I").Insert Shift:=xlToRight
.Cells(1, "I") = "Deadline SLA"
Columns("I").NumberFormat = "###0.00"

lastrow = .Cells(Rows.Count, "E").End(xlUp).Row

dt2 = CDec(Now())

For r = 2 To lastrow

dt1 = CDec(.Cells(r, "H"))

Select Case UCase(.Cells(r, "E"))

Case Is = "MEDIUM"
TimeDiff = (networkdays(dt1, dt2) + ((dt2 - Int(dt2)) - (dt1 - Int(dt1)))) * 24
.Cells(r, "I") = TimeDiff

If TimeDiff > 96 And TimeDiff <= 120 Then
.Cells(r, "I").Interior.ColorIndex = 6
End If

If TimeDiff > 120 Then
.Cells(r, "I").Interior.ColorIndex = 3
End If

Case Is = "HIGH"
TimeDiff = (networkdays(dt1, dt2) + ((dt2 - Int(dt2)) - (dt1 - Int(dt1)))) * 24
.Cells(r, "I") = TimeDiff

If TimeDiff > 60 And TimeDiff <= 72 Then
.Cells(r, "I").Interior.ColorIndex = 6
End If

If TimeDiff > 72 Then
.Cells(r, "I").Interior.ColorIndex = 3
End If

Case Is = "TOP"
TimeDiff = (dt2 - dt1) * 24
.Cells(r, "I") = TimeDiff
If TimeDiff > 3 And TimeDiff <= 4 Then
.Cells(r, "I").Interior.ColorIndex = 6
End If
If TimeDiff > 4 Then
.Cells(r, "I").Interior.ColorIndex = 3
End If
End Select
Next r

End With

End Sub
Code: