Time format code not working on first cell in range

[bdouglas1011]

I have a range B10:B47 that I thought all was working fine but then I started from scratch and found an type mismatch error.

What the code does it allows the user to choose how he enters time (12:30 or 1230)
But when you enter time in the first cell of the range if you choose to use the colon it is ok but if you don't use a colon it gives you the type mismatch error for times entered 0001 thru 0059 after that 0100 is ok)

this only happens in cell B10 all other seems to be OK.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim EndTime As Range
Dim SBlank As String
SBlank = """" & """"
Set EndTime = Range("B10:B47")

If Target.Column <> 2 Or Target.Count > 1 Or Target.row < 10 Or Target.row > 47 Then Exit Sub

If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then
    If Target.Value = "" Then
        Target.Offset(1, -1).Value = ""
        GoTo 99
    End If
    
     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
    
    If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then
        Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.row & ")," & SBlank & ",B" & Target.row & ")"
    End If
        
    Application.EnableEvents = True
End If
99:
End Sub

 

[bdouglas1011]

Disregard Thread and mark as solved

 

[smozgur]

Glad to hear you got the solution.

If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

 

[bdouglas1011]

Solution

It has been working so far

 

[bdouglas1011]

Private Sub Worksheet_Change(ByVal Target As Range)



Dim EndTime As Range

Dim SBlank As String

SBlank = """" & """"

Set EndTime = Range("B10:B47")



If Target.Column <> 2 Or Target.Count > 1 Or Target.row < 10 Or Target.row > 47 Then Exit Sub



If Not Application.Intersect(EndTime, Range(Target.Address)) Is Nothing Then

    If Target.Value = "" Then

        Target.Offset(1, -1).Value = ""

        GoTo 99

    End If

 

  Dim flag As Boolean, theEntry As Double

 

    If Not (Application.Intersect(Target, Range("B10:B47")) Is Nothing) Then

        If Target.cells.Count = 1 Then

            If IsNumeric(Target.Value) Then

                theEntry = CDbl(Target.Value)



                If 0 <= theEntry And theEntry <= 2400 Then

                    Application.EnableEvents = False



                    If theEntry < 1 Then

                        flag = True

                        Target.Value = CDate(theEntry)

                    Else

                        theEntry = Int(theEntry)

                        If theEntry Mod 100 < 60 Then

                            flag = True

                            Target.Value = TimeValue(Format(theEntry, "00:00") & ":00")

                        Else

                            ' Target.NumberFormat = "general"

                        End If

                    End If



                    Application.EnableEvents = True

                End If



            End If

            If Not flag Then MsgBox "enter a time"

        End If

    End If

 

    If TimeValue(Format(Target.Value, "hh:mm")) <> "12:00:00 AM" Then

        Target.Offset(1, -1).Value = "=IF(ISBLANK(B" & Target.row & ")," & SBlank & ",B" & Target.row & ")"

    End If

    

    Application.EnableEvents = True

End If

99:

[/CODE]