Problem with V-Basic code for displaying times in hh:mm format

  • Thread starter Thread starter Nevets
  • Start date Start date
N

Nevets

I am NOT a Visual Basic expert by any stretch. A while ago, I asked for some
help re setting up the code so that someone could quickly enter just the
numbers for a time, and the program would change that to the correct hh:mm
format when you tab out of the cell.
I received the following suggestion:

"Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tlen As Long, result As String
If Target.Column < 3 Or Target.Column > 15 Then Exit Sub
If Target.Column > 6 And Target.Column < 12 Then Exit Sub

If Target.Count > 1 Then Exit Sub
tlen = Len(Target.Value)
If tlen = 0 Then Exit Sub
Application.EnableEvents = False
If tlen = 1 And Target.Value = 0 Then GoTo endtime

If Left(Target.Value, 1) = "-" Then
MsgBox ("Cannot have negative values")
Target.Value = ""
GoTo endtime
End If

If tlen < 3 Then
MsgBox ("Invalid Entry")
Target.Value = ""
GoTo endtime
End If

If Format(Target.Value, "hh:mm") <= "23:59" And _
Format(Target.Value, "hh:mm") > "00:00" Then GoTo endtime

If Target.Value > 2359 Then
MsgBox ("Can't enter a time past 23:59")
GoTo endtime
End If

If tlen = 3 Then
result = Left(Target.Value, 1) & ":" & Right(Target.Value, 2)
Else
result = Left(Target.Value, 2) & ":" & Right(Target.Value, 2)
End If
Target.Value = result
endtime:
Target.Value = Format(Target.Value, "hh:mm")

If Format(Target.Value, "hh:mm") = "00:00" Then
Select Case MsgBox("Did you really mean to enter " _
& vbCrLf & "a time of Midnight 00:00?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Query Time input")

Case vbYes

Case vbNo
Target.Value = ""
End Select

End If
Application.EnableEvents = True
End Sub"

I gratefully copied and pasted the above into the V-Basic editor, and all
seemed to work, but recently I've discovered a problem: I can't seem to
enter a time between 0000 and 0059 hrs without getting an "Invalid Entry"
message. I tried to remove the section I thought was causing the problem:

Can anyone help?
 
Here is a simple one I use. You must enter 4 numbers such as 0001 1430

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Columns("c")) Is Nothing Then Exit Sub
'MsgBox "hi"
Application.EnableEvents = False
'Target = Format(Left(Target, 2) & ":" & Right(Target, 2), "00:00")
Target.Value = Format(Target, "00:00")
Target.NumberFormat = "hh:mm"
Application.EnableEvents = True
End Sub
 
Back
Top