PDA

View Full Version : Adjust macro (problem)



007_guy
04-28-2019, 08:31 AM
Hey guys :)

This macro calculates the difference between 2 dates (working hours only) and displayed in hours


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 = "##0.00"
End With
End With

ws_bdc_exit:
Target.Offset(1).Select

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


But, i want to modify it and do something similar to this (it calculates the difference between 2 dates BUT not i am not getting the working hours only)


Public cVal
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LastRow
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
t1 = TimeValue(CStr(Cells(i, "D").Value))
t2 = TimeValue(CStr(Cells(i, "E").Value))
t3 = TimeValue(CStr(Cells(i, "F").Value))


'input First Response time
If Hour(t2) - Hour(t1) = 0 Then
Cells(i, "G").Value = Round((Minute(t2) - Minute(t1)) / 60, 2)
Else
Cells(i, "G").Value = Hour(t2) - Hour(t1) + Round((Minute(t2) - Minute(t1)) / 60, 2)
End If


'input Elapsed Time
If Hour(t3) - Hour(t1) = 0 Then
Cells(i, "H").Value = Round((Minute(t3) - Minute(t1)) / 60, 2) '- Cells(i, "J").Value - Cells(i, "J").Value
Else
Cells(i, "H").Value = Hour(t3) - Hour(t1) + Round((Minute(t3) - Minute(t1)) / 60, 2) '- Cells(i, "J").Value
End If
Next i


Target.Offset(1).Select
End Sub



Could you please help me to modify it?

007_guy
04-28-2019, 03:09 PM
Could you please help me to obtain the difference between 2 dates?