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?
Printable View
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?
Quote:
Originally Posted by xld
Dude, your macro is working but now everything has changed. This is the full macro i am using:
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)Code: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
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
Quote:
Originally Posted by xld
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