Work hours between 2 dates(not working -VBA)

[007_guy]

It seems to be working BUT it does not display the input in hours. It still shows the input with the format 0:00, do you get me?

[007_guy]

That should read

.NumberFormat = "##0.00"

(extra quote).

Dude, your macro is working but now everything has changed. This is the full macro i am using:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Const WORKING_DAY_START As String = "09:00"
Const WORKING_DAY_END As String = "18:00"
Const FORMULA_WORKING_TIME As String = _
    "=(INT(E2-D2)*(""" & WORKING_DAY_END & """-""" & WORKING_DAY_START & """)" & _
    "+MEDIAN(MOD(E2,1),""" & WORKING_DAY_END & """,""" & WORKING_DAY_START & """)" & _
    "-MEDIAN(MOD(D2,1),""" & WORKING_DAY_END & """,""" & WORKING_DAY_START & """))"
Const FORMULA_ELAPSED_TIME As String = "=F2-D2"
Dim lastrow As Long


    On Error GoTo ws_bdc_exit
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    With Me
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        'input Elapsed Time
        .Range("H2").Resize(lastrow - 1).Formula = FORMULA_ELAPSED_TIME
        
        'input First Response time
        .Range("G2").Resize(lastrow - 1).Formula = FORMULA_WORKING_TIME
        
        With .Range("G2:H2").Resize(lastrow - 1)
            .Value = .Value
            .NumberFormat = "[h]:mm_w"
        End With
    End With
   
ws_bdc_exit:
    Target.Offset(1).Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, LastRow
LastRow = Range("C" & Rows.Count).End(xlUp).Row + 10
'adjust Extra Time
If Target.Column = 10 Then
    If Target.Value <> "" Then
        Target.Offset(0, -2).Value = Target.Offset(0, -2).Value - Target.Value
    ElseIf Target.Value = "" Then
        Target.Offset(0, -2).Value = Target.Offset(0, -2).Value + cVal
    End If
End If


Application.EnableEvents = False
'clear fill from deleted entries
For i = 2 To LastRow
    If Cells(i, "C").Value = "" Then
        Range("G" & i & ":" & "H" & i).ClearContents
        Range("G" & i & ":" & "H" & i).Interior.ColorIndex = xlNone
    End If
    
    If Cells(i, "G").Value = "" Then
        Range("G" & i & ":" & "H" & i).Interior.ColorIndex = xlNone
    End If
Next i


'Evaluate First Response Time
For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "High" And Cells(i, "G").Value <> "" And Cells(i, "G").Value <= Range("o2").Value Then
        Cells(i, "G").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "High" And Cells(i, "G").Value <> "" And Cells(i, "G").Value > Range("o2").Value Then
        Cells(i, "G").Interior.ColorIndex = 3
    End If
Next i


For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "Medium" And Cells(i, "G").Value <> "" And Cells(i, "G").Value <= Range("o3").Value Then
        Cells(i, "G").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "Medium" And Cells(i, "G").Value <> "" And Cells(i, "G").Value > Range("o3").Value Then
        Cells(i, "G").Interior.ColorIndex = 3
    End If
Next i


For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "Low" And Cells(i, "G").Value <> "" And Cells(i, "G").Value <= Range("o4").Value Then
        Cells(i, "G").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "Low" And Cells(i, "G").Value <> "" And Cells(i, "G").Value > Range("o4").Value Then
        Cells(i, "G").Interior.ColorIndex = 3
    End If
Next i


'Evaluate Elapsed Time
For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "High" And Cells(i, "H").Value <> "" And Cells(i, "H").Value <= Range("P2").Value Then
        Cells(i, "H").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "High" And Cells(i, "H").Value <> "" And Cells(i, "H").Value > Range("P2").Value Then
        Cells(i, "H").Interior.ColorIndex = 3
    End If
Next i
    
For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "Medium" And Cells(i, "H").Value <> "" And Cells(i, "H").Value <= Range("P3").Value Then
        Cells(i, "H").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "Medium" And Cells(i, "H").Value <> "" And Cells(i, "H").Value > Range("P3").Value Then
        Cells(i, "H").Interior.ColorIndex = 3
    End If
Next i


For i = 2 To LastRow
    If UCase(Cells(i, "C").Value) = "Low" And Cells(i, "H").Value <> "" And Cells(i, "H").Value <= Range("P4").Value Then
        Cells(i, "H").Interior.ColorIndex = 35
    ElseIf UCase(Cells(i, "C").Value) = "Low" And Cells(i, "H").Value <> "" And Cells(i, "H").Value > Range("P4").Value Then
        Cells(i, "H").Interior.ColorIndex = 3
    End If
Next i
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 10 Then
    cVal = Target.Value
End If
End Sub

If i use your Macro, everytime that i enter an "extra time" it will adjust The Elapsed Time value and it is correct but something is wrong because if i put an extra time and double click again on Date of the problem/Date First Response/Date Last Response it will put the original value on "The Elapsed Time" cell and thats not correct. It should not modify anything! (PS: i have to double click on "extra time" to modify the value stored in "The Elapsed Time" and in my previous Macro it was not necessary)


Also, if First response and Elapsed time have a value >, < or equal to the other values (depending on the priority) it will have a different colour but with your Macro it has stopped working properly. Why?

Could you please help me to solve this mess?

Take a look at this imag:

https://imgur.com/a/RqIYOA4

[007_guy]

That should read

.NumberFormat = "##0.00"

(extra quote).

Dude, i think there was a misunderstanding..
First response is calculated by the difference between: Date First Response and Date of the problem
Elapsed time is calculated by the difference between: Date Last Response and Date of the problem

THAT's the problem in your Macro