Hours Minutes .... VBA

[jamada]

Hi

I ahve the following code that works fantastic. when the user enters a number in the target range it automatically is accepted as HH:MM, it is extremily helpfull when work with HHMM. This o cousre iliminates the need for continuousely entering the "Shift colon key :"


I would like to take this just up a notch, the code below only converts numbers that are
below 24:00 i.e 2359. Entering 2359, results in 23:59 which is good, entering 2400 results in unwanted form 57600:00.

Any suggestions please, thank you.


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B3:G21")) Is Nothing Then Exit Sub ' not wanted

Dim TimeStr As String

On Error GoTo EndMacro

If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeValue(TimeStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You Must Enter a Valid Time"
Application.EnableEvents = True

 

[kpark91]

Try changing this line of code

.Value = TimeValue(TimeStr)

to

.Value = TimeStr

 

[jamada]

WOW that was fast...... That did the trick for hours/minutes up to 99, any thouhts for 100 hours and more i.e 100:00 - 150:00


Thank You

 

[kpark91]

Try

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("B3:G21")) Is Nothing Then Exit Sub ' not wanted

Dim TimeStr As String

On Error GoTo EndMacro

If Target.Value = "" Then
Exit Sub
End If

Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Value)
Case 1 ' e.g., 1 = 00:01
TimeStr = "00:0" & .Value
Case 2 ' e.g., 12 = 00:12
TimeStr = "00:" & .Value
Case 3 ' e.g., 735 = 7:35
TimeStr = Left(.Value, 1) & ":" & _
Right(.Value, 2)
Case 4 ' e.g., 1234 = 12:34
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
TimeStr = Left(.Value, 1) & ":" & _
Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
Case 6 ' e.g., 123456 = 12:34:56
TimeStr = Left(.Value, 2) & ":" & _
Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
Case 7 'e.g., 1234556 = 123:45:56
TimeStr = Left(.Value, 3) & ":" & _
Mid(.Value, 4, 2) & ":" & Right(.Value, 2)
Case Else
Err.Raise 0
End Select
.Value = TimeStr
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "You Must Enter a Valid Time"
Application.EnableEvents = True

 

[jamada]

Hi.... I sustituted the code, however its not provideing desired result.

To get the result of 125:30, I must now enter 1,2,5,3,0...0,0

Was looking for 12530 would result in 125:30.

thanks
Graham

 

[kpark91]

but there is no way the code can tell whether you want
125:30 or 12:53:00 with 1,2,5,3,0 (Ambuguity is present)

 

[jamada]

K...... So i see what you mean, but is there a way to drop the consideration of "Seconds" from the code. My use only considers HH:MM, no use for seconds!

Tks G

 

[kpark91]

Try (this is not tested)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3:G21")) Is Nothing Then Exit Sub ' not wanted
 
    Dim TimeStr As String
 
    With Target
        If .Value = "" Then Exit Sub
        If Len(.Value) - Len(Replace(.Value, ":", "") = 2) Then
            TimeStr = .Value
        ElseIf Len(.Value) - Len(Replace(.Value, ":", "")) <> 2 And IsNumeric(.Value) = True Then
            Select Case (Len(.Value))
            Case 1 To 2
                TimeStr = "0:" & .Value
            Case Else
                TimeStr = Left(.Value, Len(.Value) - 2) & ":" & Right(.Value, 2)
            End Select
        Else
            Err.Raise 0
            MsgBox ("Please enter a valid input (###### or ##:##)")
            Exit Sub
        End If
        .Value = TimeStr
    End With
End Sub

 

[kpark91]

I've made a mistake,
use this instead

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3:G21")) Is Nothing Then Exit Sub ' not wanted
 
    Dim TimeStr As String
 
    With Target
        If .Value = "" Then Exit Sub
        If Len(.Value) - Len(Replace(.Value, ":", "") = 1) Then
            TimeStr = .Value
        ElseIf Len(.Value) - Len(Replace(.Value, ":", "")) <> 1 And IsNumeric(.Value) = True Then
            Select Case (Len(.Value))
            Case 1 To 2
                TimeStr = "0:" & .Value
            Case Else
                TimeStr = Left(.Value, Len(.Value) - 2) & ":" & Right(.Value, 2)
            End Select
        Else
            Err.Raise 0
            MsgBox ("Please enter a valid input (###### or ##:##)")
            Exit Sub
        End If
        .Value = TimeStr
    End With
End Sub

 

[jamada]

Oh oh!

Now it interprets every entry as 24:00

i.e. Enter 1 becomes 24:00
Enter 3 becomes 72:00
Eneter 111 becomes 2664:00


?

Tks G