leading zero issue when converting to time format

[MJKelly]

Hi,

I am trying to convert a numeric cell entry to time format, but I am
also checking the time is in multiples of ten minutes ie 12:10 and not
12:01.

I have written the code below, which works to a degree, but if I type
0600 i get an invalid entry prompt. I think is because of excel not
seeing the leading zero? How can I force this? I tried formatting to
"0000", but its not worked.

The msgbox's are just there to help me check the error capture

hope you can help,
Matt



Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrHandler
'Target.NumberFormat = "0000"
'MsgBox Len(Target.Value)

If Application.Intersect(Target, Range("E3:E10")) Is Nothing Then
'check the range needs to be queried
Exit Sub
End If
If Target.Cells.Count > 1 Then 'check only one cell has been changed
Exit Sub
End If
If Target.Value = "" Then 'check to see if the cell is empty
Exit Sub
End If

If Target.Value > 9999 Then 'check the entry is less than four digits
GoTo ErrHandler
End If

Application.EnableEvents = False

With Target
If Len(.Value) = 3 Then 'add the leading zero?
MsgBox "YES"
.Value = "0" & .Value
End If

MsgBox Left(.Value, 2) 'check the hours digits are less than 24
If Left(.Value, 2) > 23 Then
GoTo ErrHandler
End If
MsgBox Right(Target.Value, 2) 'check the minutes digits are 50 or
less
If Right(Target.Value, 2) > 50 Then
GoTo ErrHandler
End If

MsgBox Right(Target.Value, 1) 'check the minute is a multiple of
ten minutes
If Right(Target.Value, 1) <> 0 Then
GoTo ErrHandler
End If
End With

Dim TimeStr As String 'change to time format
With Target
TimeStr = Left(.Value, 2) & ":" & _
Right(.Value, 2)
.Value = TimeValue(TimeStr)
End With

Application.EnableEvents = True

byebye:
Exit Sub

ErrHandler:
MsgBox "Invalid data entered"
Target.Value = ""
Application.EnableEvents = True
GoTo byebye

End Sub

 

[Don Guillett]

Here is a simple on I use that assumes a 4 digit entry

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
Application.EnableEvents = False

Target.Value = Format(Target, "00:00")
Target.NumberFormat = "hh:mm"

Application.EnableEvents = True
End Sub