Timespan Starting With Active Cell Value Using Input Box Value

[Smd747]

I have this code that works great. When I click on the macro "TimeSpanCheck"

Sub TimeSpanCheck()

Dim Break               As Long
Dim Prompt              As String
Dim Title               As String
Dim StartTime           As Date
Dim EndTime             As Date
Dim Duration            As Date
Dim Cel                 As Range

    If ActiveSheet Is Nothing Then
        Beep
        GoTo ExitSub:
    End If

    Prompt = "Select the start time."
    Title = "Start Time Specification"
    On Error Resume Next
    Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)
    On Error GoTo 0
    If Cel Is Nothing Then
        GoTo ExitSub:
    End If
    StartTime = CDate(Cel.Value)

    Prompt = "Select the end time."
    Title = "End Time Specification"
    On Error Resume Next
    Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)
    On Error GoTo 0
    If Cel Is Nothing Then
        GoTo ExitSub:
    End If
    EndTime = CDate(Cel.Value)

    Prompt = "Enter the break time in minutes to deduct."
    Title = "Break Time Specification"
    Break = Val(InputBox(Prompt, Title, 60))
    If Break < 0 Then
        Break = 0
    End If

    If EndTime > StartTime Then
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0)
    Else
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0) + 1
    End If

    Prompt = "The duration is: " & Format(Duration, "h:mm")
    Title = "Calcuation Results"
    MsgBox Prompt, vbInformation, Title

ExitSub:

    Set Cel = Nothing

End Sub

However it prompt me for the start time when I usually start this with the active cell that I am in and I have to click in the cell again.

So I attempted to modify my code and have the first input box start up with the active cell value (Time Value). I got it to work however it is giving me the wrong time value. If I go back to the original one it is correct. I believe it has to do with perhaps "StartTime = CDate(Cel.Value)" converting the input cell value. the original is reading the time value.

Here is my code not calculating correctly.

Sub ActiveCellTimeSpanCheck()

Dim Break               As Long
Dim Prompt              As String
Dim Title               As String
Dim StartTime           As Date
Dim EndTime             As Date
Dim Duration            As Date
Dim Cel                 As Range

    If ActiveSheet Is Nothing Then
        Beep
        GoTo ExitSub:
    End If
    
    Prompt = "Select the start time."
    Title = "Start Time Specification"
    On Error Resume Next
    ActiveCell = CDate(Cel.Value)
    'Want to always start with the active Cell
    Set Cel = Application.InputBox(Prompt, Title, CDate(ActiveCell.Value))
    'My original line : Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)' works great but have to select first
'    On Error GoTo 0
'    If Cel Is Nothing Then
'        GoTo ExitSub:
'    End If
'    StartTime = CDate(Cel.Value)
    
    Prompt = "Select the end time."
    Title = "End Time Specification"
    On Error Resume Next
    Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)
    On Error GoTo 0
    If Cel Is Nothing Then
        GoTo ExitSub:
    End If
    EndTime = CDate(Cel.Value)
    
    Prompt = "Enter the break time in minutes to deduct."
    Title = "Break Time Specification"
    Break = Val(InputBox(Prompt, Title, 60))
    If Break < 0 Then
        Break = 0
    End If
    
    If EndTime > StartTime Then
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0)
    Else
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0) + 1
    End If
    
    Prompt = "The duration is: " & Format(Duration, "h:mm")
    Title = "Calcuation Results"
    MsgBox Prompt, vbInformation, Title

ExitSub:

    Set Cel = Nothing
    
End Sub

This code unlike the original give me the wrong time
Example original code Start time 8:00 AM End Time 5:00 PM minus an hour lunch result is 8:00 the modified code result is 16:00

anyone see what I am doing incorrectly Thanks

[Admin]

Hi

Welcome to ExcelFox!

Try this

Option Explicit


Sub ActiveCellTimeSpanCheck()

Dim Break               As Long
Dim Prompt              As String
Dim Title               As String
Dim StartTime           As Date
Dim EndTime             As Date
Dim Duration            As Date
Dim Cel                 As Range
Dim varSTime            As Variant


    If ActiveSheet Is Nothing Then
        Beep
        GoTo ExitSub:
    End If
    
    Prompt = "Select the start time."
    Title = "Start Time Specification"
    On Error Resume Next
    ActiveCell = CDate(Cel.Value)
    'Want to always start with the active Cell
    
    varSTime = Application.InputBox(Prompt, Title, CDate(ActiveCell.Value))
    
    'My original line : Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)' works great but have to select first
'    On Error GoTo 0
'    If Cel Is Nothing Then
'        GoTo ExitSub:
'    End If
    
    StartTime = CDate(varSTime)
    
    Prompt = "Select the end time."
    Title = "End Time Specification"
    On Error Resume Next
    Set Cel = Application.InputBox(Prompt, Title, , , , , , 8)
    On Error GoTo 0
    If Cel Is Nothing Then
        GoTo ExitSub:
    End If
    EndTime = CDate(Cel.Value)
    
    Prompt = "Enter the break time in minutes to deduct."
    Title = "Break Time Specification"
    Break = Val(InputBox(Prompt, Title, 60))
    If Break < 0 Then
        Break = 0
    End If
    
    If EndTime > StartTime Then
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0)
    Else
        Duration = EndTime - StartTime - TimeSerial(0, Break, 0) + 1
    End If
    
    Prompt = "The duration is: " & Format(Duration, "h:mm")
    Title = "Calcuation Results"
    MsgBox Prompt, vbInformation, Title

ExitSub:

    Set Cel = Nothing
    
End Sub

[Smd747]

Thank you for the direction and solution. I did several tests with the adjusted code and it worked like the original. Thank you


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[Rick Rothstein]

Thank you for the direction and solution. I did several tests with the adjusted code and it worked like the original. Thank you

Just to follow up...

Admin's solution does not actually work like you intended your original code to... in your original code, you were able to select the cell that contained the date if your active cell was not the correct one, Admin's solution would have you typing the date in under that circumstance. The following method would default the InputBox to the active cell's address, but would allow you to select a different cell if the active cell was not on the correct date to begin with (no typing required)...

Set Cel = Application.InputBox(Prompt, Title, ActiveCell.Address, , , , , 8)


https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

[Smd747]

In hind site, Ideally what I would like is when iI click the macro button that activates the code it prompts me for the ending time because the start time was automatically captured as being the active cell. with this code. Mod it confirms the active cell time is correct but I still have to click ok to get the prompt for the ending time
The above will save me a click

I'm think that at the end you get a message box that shows what the start was, what the ending time was and the break time deducted. And of course what the answer the is as a complete check

Do not know if this is possible

Still testing your suggestion will post test results later

[Rick Rothstein]

In hind site, Ideally what I would like is when iI click the macro button that activates the code it prompts me for the ending time because the start time was automatically captured as being the active cell. with this code. Mod it confirms the active cell time is correct but I still have to click ok to get the prompt for the ending time
The above will save me a click

I'm think that at the end you get a message box that shows what the start was, what the ending time was and the break time deducted. And of course what the answer the is as a complete check

Something like this maybe...

Sub GetStartEndTime()
  Dim StartTime As Date, EndTime As Date, TimeDiff As String
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  TimeDiff = Format(EndTime - StartTime, "h"" hours and ""m"" minutes""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff
End Sub

[Smd747]

Your mod works very well, I like the hours and minutes to the value, thats really cool. Is it possible to add the break value to this code to say minus 60 minutes the value of the input which is either 30 or 60 ? this way I don't have to mentally deduct it from the times to get the value. Thanks you for the help and direction

[Rick Rothstein]

Your mod works very well, I like the hours and minutes to the value, thats really cool. Is it possible to add the break value to this code to say minus 60 minutes the value of the input which is either 30 or 60 ? this way I don't have to mentally deduct it from the times to get the value. Thanks you for the help and direction

I don't understand the part I highlighted in red... what is to be subtracted 30 or 60 and how is the code supposed to know which? Please give me an example and show me what the message box should say for the time difference for that example.

[Smd747]

How could I hard code 60 which is 60 minutes lunch break or 1-hour

TimeDiff = Format(EndTime - StartTime, "h"" hours and ""m"" minutes""") - 60

did not work. I'm thinking I can have two buttons one for a 60 minute lunch break or 30 minute lunch break break to be deducted at the end. I hope I explained it better, sorry

[Smd747]

I am thinking something like this, but can not get it to work yet

Sub TestGetStartEndTime()
  Dim StartTime As Date, EndTime As Date, BreakTime As Date, TimeDiff As String
  BreakTime = CDate(1.00)
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  TimeDiff = Format(EndTime - StartTime, "h"" hours and ""m"" minutes""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff - BreakTime
End Sub

Keep getting error code 13