Consulting

Results 1 to 2 of 2

Thread: Adjust macro (problem)

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

    Adjust macro (problem)

    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?

  2. #2
    VBAX Regular
    Joined
    Apr 2019
    Posts
    15
    Location
    Could you please help me to obtain the difference between 2 dates?
    Last edited by 007_guy; 04-28-2019 at 03:22 PM.

Tags for this Thread

Posting Permissions

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