Error when adding minutes without hours... Please help :(

[Shawndapew]

Hello, all. I have this crazy time sheet spreadsheet. My district managers asked me to try and make it where they can enter 130 for 1:30 so they can enter start and stop times faster. I was finally able to achieve this by formatting the start and end times as 1:30PM and the drive time as 13.30

I have the following code on the worksheet so the ":" is entered automatically. The range "Time" set just for the time cell on the sheet (I did not define a range at first, so it was applied to the whole page and text entries were automatically entering a ":" before the last two characters of anything I typed).


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
Set rng = Intersect(Target, Range("Time"))
If rng Is Nothing Then Exit Sub
UserInput = Target.Value
If UserInput > 1 Then
NewInput = Left(UserInput, Len(UserInput) - 2) & ":" & Right(UserInput, 2)
Application.EnableEvents = False
Target = NewInput
Application.EnableEvents = True
End If
End Sub

So here is the issue, the "DRIVE TIME" is not a formula number. I enter 30 and the code tells it to me :30
Again, the cell is formatted as 13:30. When I add up COLUMN D, THE VALUE COMES BACK AS 0:00
*the cell where I want the totals is formatted as [h]:mm
Please help before I lose my mind


A B C D

START TIME	END TIME	TOTAL TIME	DRIVE TIME
8:00 AM	9:00 AM	1:00	:30
9:00 AM	10:00 AM	1:00	:45
10:00 AM	11:00 AM	1:00	:15

<colgroup><col width="40" style="width: 30pt; mso-width-source: userset; mso-width-alt: 1462;" span="4"> <tbody> </tbody>

 

[steve the fish]

Try this, allows you to put single digits in now:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
Set rng = Intersect(Target, Range("Time"))
If rng Is Nothing Then Exit Sub
UserInput = Target.Value

On Error Resume Next
If Len(UserInput) = 1 Or Len(UserInput) = 2 Then
    NewInput = "0:" & Right(UserInput, 2)
Else
    NewInput = Left(UserInput, Len(UserInput) - 2) & ":" & Right(UserInput, 2)
End If
On Error GoTo 0

Application.EnableEvents = False
Target = NewInput
Application.EnableEvents = True

End Sub

 

[Snakehips]

Shawndapew,

That is likely because you have multiple cells selected when clearing.
Also it might be worth guarding against a non- numeric entry, which currently would also cause an error.

Alter the code as below..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Then Exit Sub


Set rng = Intersect(Target, Range("Time"))
If rng Is Nothing Then Exit Sub
UserInput = Target.Value
If UserInput > 1 Then


If Left(UserInput, Len(UserInput) - 2) = "" Then
NewInput = "0:" & Right(UserInput, 2)
Else
NewInput = Left(UserInput, Len(UserInput) - 2) & ":" & Right(UserInput, 2)
End If


Application.EnableEvents = False
Target = NewInput
Application.EnableEvents = True
End If
End Sub

 

[Shawndapew]

@Snakeships & Steve:

This group of people here is awesome! I wish I has asked for help three weeks ago. These were my final two issues and now we are ready to track our COGS as we should! Thank you guys for your assistance!!!!!!!

 

[Snakehips]

You are welcome.

Also just realised that you may wish to guard against an error caused by more than four digits.....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r As Range
If Target.Cells.Count > 1 Then Exit Sub
If Not IsNumeric(Target) Or Len(Target) > 4 Then
Beep
MsgBox "Invalid entry  -  Please try again"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Set rng = Intersect(Target, Range("Time"))
If rng Is Nothing Then Exit Sub
UserInput = Target.Value
If UserInput > 1 Then


If Left(UserInput, Len(UserInput) - 2) = "" Then
NewInput = "0:" & Right(UserInput, 2)
Else
NewInput = Left(UserInput, Len(UserInput) - 2) & ":" & Right(UserInput, 2)
End If


Application.EnableEvents = False
Target = NewInput
Application.EnableEvents = True
End If
End Sub

 

[Snakehips]

Shawndapew,

I don't wish to burst your bubble but just be aware that the current code won't accept drive minutes between 1 and 9.
Try it with 8 minutes or 08

Also you can input say 99 which will give 1:39 yet 100 will give 1:00

Unless you happy that your users will be sufficiently disciplined not to do the wrong thing then the code needs tightening up some. Possibly coupled with some data validation rules.