Timespan Starting With Active Cell Value Using Input Box Value

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

Code:

---

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.

Code:

---

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

Hi

Welcome to ExcelFox!

Try this

Code:

---

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

---

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

Quote:

---

Originally Posted by Smd747

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

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

Quote:

---

Originally Posted by 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

---

Something like this maybe...

Code:

---

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

---

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

Quote:

---

Originally Posted by 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

---

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.

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

Code:

---

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

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

Code:

---

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

Quote:

---

Originally Posted by Smd747

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

Code:

---

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

---

The part I highlighted in red is the calculated value (the Format function displays the calculated value in a "formatted" way), so that is the value that the lunch break time should be subtracted from, but you cannot just subtract 60 for 60 minutes as 60 is not a time value (which is what StartTime and EndTime are), rather, you can use the TimeSerial function and let it construct the time for you for your given number of minutes. For example...

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

I think I would modify the code to handle the break time separately in the MessageBox, otherwise the start/end times and displayed difference won't "add up". However, I wasn't sure how you would want to report the time difference, so I have given you two macros to choose from (pick the one with the output you like best)...

Code:

---

Sub GetStartEndTime1()
  Dim StartTime As Date, EndTime As Date, BreakTime As Long, TimeDiff As String
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  BreakTime = 60 'Not sure how you plane to calculate 30 or 60, but it goes here
  TimeDiff = Format(EndTime - StartTime, "h"" hours and ""m"" minutes with a " & BreakTime & " minute break.""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff
End Sub

---

Code:

---

Sub GetStartEndTime2()
  Dim StartTime As Date, EndTime As Date, BreakTime As Long, TimeDiff As String
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  BreakTime = 60 'Not sure how you plane to calculate 30 or 60, but it goes here
  TimeDiff = Format(EndTime - StartTime - TimeSerial(0, BreakTime, 0), _
            "h"" hours and ""m"" minutes which excludes a " & BreakTime & " minute break.""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff
End Sub

---

Thank you Rick
Code2

Code:

---

Sub GetStartEndTime2()
  Dim StartTime As Date, EndTime As Date, BreakTime As Long, TimeDiff As String
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  BreakTime = 60 'Not sure how you plane to calculate 30 or 60, but it goes here
  TimeDiff = Format(EndTime - StartTime - TimeSerial(0, BreakTime, 0), _
            "h"" hours and ""m"" minutes which excludes a " & BreakTime & " minute break.""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff
End Sub

---

works fine. It deducts the Break Time and displays the actual time worked. I am still studying your code to fully understand it and to learn from it. Thanks again for your help and direction.

First hiccup with the new code. It does not account for overnight . When I click active cell 6:00 PM and ending cell 2:30 AM it give me 16 hours
Do I need to use the mod function??

Quote:

---

Originally Posted by Smd747

First hiccup with the new code. It does not account for overnight . When I click active cell 6:00 PM and ending cell 2:30 AM it give me 16 hours

---

Try it like this and let me know if it works for you or not...

Code:

---

Sub GetStartEndTime2()
  Dim StartTime As Date, EndTime As Date, BreakTime As Long, TimeDiff As String
  StartTime = ActiveCell.Value
  EndTime = Application.InputBox("Select the cell with the ending time...", Type:=8)
  BreakTime = 60 'Not sure how you plane to calculate 30 or 60, but it goes here
  TimeDiff = Format(24 + EndTime - StartTime - TimeSerial(0, BreakTime, 0), _
            "h"" hours and ""m"" minutes which excludes a " & BreakTime & " minute break.""")
  MsgBox "Start time: " & StartTime & vbLf & "End time: " & EndTime & vbLf & "Time difference: " & TimeDiff
End Sub

---

Thanks Rick, that fixed the time calculation. It is working beautifully now, what a time saver. I have a ribbon button for 30 minute 1/2 hour break and another for 60 minutes 1-hour break

Thanks for the help and learning experience in VBA

Quote:

---

Originally Posted by Smd747

Thanks Rick, that fixed the time calculation. It is working beautifully now, what a time saver. I have a ribbon button for 30 minute 1/2 hour break and another for 60 minutes 1-hour break

---

Great!

Quote:

---

Originally Posted by Smd747

Thanks for the help and learning experience in VBA

---

You are quite welcome... I am glad I was able to be of assistance to you.