Consulting

Page 1 of 2 1 2 LastLast
Results 1 to 20 of 23

Thread: Work hours between 2 dates(not working -VBA)

  1. #1
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location

    Work hours between 2 dates(not working -VBA)

    Hey guys, how are you?
    Could you please help me to obtain the work hours between2 dates and improve my macro? I am not an expert and VBA is a little tricky :/


    Take a look at this image:
    https://imgur.com/a/ajPJoMz


    Thanks
    Attached Files Attached Files

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Why not just use a formula?

    Assuming weekends get included

    =(INT(E2-D2)*("18:00"-"09:00")
    +MEDIAN(MOD(E2,1),"18:00","09:00")
    -MEDIAN(MOD(D2,1),"18:00","09:00"))*24
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    Why not just use a formula?

    Assuming weekends get included

    =(INT(E2-D2)*("18:00"-"09:00")
    +MEDIAN(MOD(E2,1),"18:00","09:00")
    -MEDIAN(MOD(D2,1),"18:00","09:00"))*24

    Thank you for replying!
    I want to use a macro, i've tried to use something similar but it did not work :/

    Could you please help me to modify it?

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    I cannot see why you want a macro over a formula, but if you must, create some code to inject the formula, and then value it.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    I cannot see why you want a macro over a formula, but if you must, create some code to inject the formula, and then value it.
    Well, thats the problem .. i dont know how to modify it :/

  6. #6
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    I cannot see why you want a macro over a formula, but if you must, create some code to inject the formula, and then value it.
    My macro in stored in the workbook document inside the excel file

  7. #7
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    This code does it.

    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 & """))"
    Dim lastrow As Long
    
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
            With Range("G2").Resize(lastrow - 1)
            
                .Formula = FORMULA_WORKING_TIME
                .Value = .Value
                .NumberFormat = "[h]:mm"
            End With
        End With
    I have used all the constants so as to make it easy to amend if the start/end day times change. I have also output the answer as hh:mm as this makes more sense (to me) than decimals.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  8. #8
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    This code does it.

    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 & """))"
    Dim lastrow As Long
    
        With ActiveSheet
        
            lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row
            With Range("G2").Resize(lastrow - 1)
            
                .Formula = FORMULA_WORKING_TIME
                .Value = .Value
                .NumberFormat = "[h]:mm"
            End With
        End With
    I have used all the constants so as to make it easy to amend if the start/end day times change. I have also output the answer as hh:mm as this makes more sense (to me) than decimals.


    I've tried to merge that code in my macro but it did not work
    Could you please help me to modify my macro? (this is inside the excel file)

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    There is a lot of code in that workbook. Post the workbook that yoi modified with your modification, and tell me how to trigger the thing you want.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  10. #10
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Dude, check the image (https://imgur.com/a/ajPJoMz)
    This is my code, it calculates the time between 2 dates BUT not the work hours. I tried to modify it but it did not work :/:
    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

  11. #11
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    If you post the workbook, and tell me how to trigger the thing you want, and I will look. I do not have time nor inclination to try and work it out from pictures and code snippets.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  12. #12
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Well, it goes like this:
    When you enter any date/time inside the field "Date of the problem" AND "Date first response" you should display the difference between both dates in the other field called "Date Last Response". I mean, double click any cell to input values.Finally, there is a field called "EXTRA TIME" and entering an 'Extra Time' value will adjust the Elapsed Time value AND Deleting an Extra Time' value will return the original Elapsed Time value.


    Thats basically everything.

    This is my WORKSHEET:
    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
    
    
    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) = "ALTA" 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) = "ALTA" 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) = "MEDIA" 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) = "MEDIA" 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) = "BAJA" 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) = "BAJA" 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) = "ALTA" 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) = "ALTA" 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) = "MEDIA" 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) = "MEDIA" 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) = "BAJA" 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) = "BAJA" 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

  13. #13
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    I have changed the code, and I have kept your methodology, but it is not good because you are not using events as they should be used, to respond to the target of the event and any related items. Instead, you are changing everything. To compound it, when the values in D, E, or F change, you are not updating the calculated times, that has to wait for the user to trigger it on the next double-click.

    Your code should check C, and update that row alone. Similarly, it should check D and E, if either is changed and both have values, calculate the working time; it should check D & F, if either is changed and both have values then calculate the elapsed time.

    Ayway, here is the 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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  14. #14
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Thank you for replying!
    it seems to be working BUT i was no able to obtain the "Extra time" :/. I tried to use my code but it fails
    Last edited by Bob Phillips; 04-26-2019 at 01:36 AM. Reason: Removed previous message quote

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Sorry, I am not sure what you mean, my code does working time and elapsed time.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  16. #16
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    Sorry, I am not sure what you mean, my code does working time and elapsed time.
    Your code is working, it shows the difference between the different dates BUT i want to display the input in hours (NOT hours + minutes).
    How would you change it?

  17. #17
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    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
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  18. #18
    VBAX Regular
    Joined
    Apr 2019
    Posts
    23
    Location
    Quote Originally Posted by xld View Post
    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

    It throws syntax error on this line: .NumberFormat = ##0.00"

  19. #19
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    That should read

    .NumberFormat = "##0.00"

    (extra quote).
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  20. #20
    VBAX Newbie
    Joined
    Aug 2016
    Posts
    3
    Location
    Quote Originally Posted by 007_guy View Post
    It throws syntax error on this line: .NumberFormat = ##0.00"

    .NumberFormat = "##0.00"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •