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 (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 (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

[Rick Rothstein]

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
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)...

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


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

[Smd747]

Thank you Rick
Code2

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.

[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
Do I need to use the mod function??

[Rick Rothstein]

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...

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

[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

Thanks for the help and learning experience in VBA

[Rick Rothstein]

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!


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.