CODEWITHSUNDEEP
excelvba
Eran Peer
Eran Peer

Reputation: 73

How to create Text Box with hour format only (HH:mm) on vba

I need to create a TextBox that work only with a date format (HH: mm) That the user can only write Specific an hour (12:34) and not (12:65) or (1200) how can I do that?

The code is:

 Private Sub bTNOK_Click()

    TextBoxHour.Value = Format(TextBoxHour.Value, "HH:mm")

End Sub

Private Sub UserForm_Initialize()

    TextBoxHour.Value = "00:00"
    TextBoxHour.MaxLength = 5


End Sub

Thank you for your help!

Upvotes: 0

Views: 4375

Answers (3)

IAmNerd2000
IAmNerd2000

Reputation: 771

I would suggest making a Boolean check as PGCodeRider suggested. Here is my suggested Function

    Public Function IsGoodTime(ByVal strInString As String) As Boolean
        Dim blnOut As Boolean
        Dim intPos As Integer
        Dim strTemp As String
        Dim strLeft As String
        Dim strRight As String
        Dim intLeft As Integer
        Dim intRight As Integer

        blnOut = True
        strTemp = Trim(strInString)

        intPos = InStr(1, strTemp, ":")
        If intPos > 0 Then
            strLeft = Mid(strTemp, 1, intPos - 1)
            strRight = Mid(strTemp, intPos + 1, Len(strTemp))
        Else
            strRight = Right(strTemp, 2)
            strLeft = Mid(strTemp, 1, Len(strTemp) - 2)
        End If

        intLeft = 0
        intRight = 0
        If IsNumeric(strLeft) Then intLeft = CInt(strLeft)
        If IsNumeric(strRight) Then intRight = CInt(strRight)

        If (Not ((intLeft > 0) And (intLeft < 13))) Then blnOut = False
        If (Not ((intRight > 0) And (intRight < 60))) Then blnOut = False

        IsGoodTime = blnOut

    End Function

Upvotes: 0

pgSystemTester
pgSystemTester

Reputation: 9932

A custom function that returns True or False would probably be best. If users enters something that returns False, have code go back and user enters new number.

This was about the best I could think of to defend against unsophisticated user entries. 

Function CheckTime(inputasString) As Boolean

Dim theDoubleDotThing As Long

theDoubleDotThing = InStr(1, inputasString, ":", vbBinaryCompare)

If theDoubleDotThing = 0 Then
    GoTo NOPE
End If



Dim theHOUR As Long, theMinute As Long

On Error GoTo NOPE
    theHOUR = CLng(Mid(inputasString, 1, theDoubleDotThing - 1))
    theMinute = CLng(Right(inputasString, 2))
On Error GoTo 0

If Right(inputasString, 3) <> ":" & Right(inputasString, 2) Then
    GoTo NOPE

ElseIf theHOUR > 12 Then
    GoTo NOPE

ElseIf theMinute > 60 Then
    GoTo NOPE
End If

CheckTime = True

Exit Function
NOPE:


End Function

So putting this into your code....

Private Sub bTNOK_Click()

    If CheckTime(textboxhour.Value) Then

    textboxhour.Value = Format(textboxhour.Value, "HH:mm")

    Else
        MsgBox "what the heck is " & textboxhour.Value & "?!?!?", vbCritical, Title:="Come On Man"

    End If

End Sub

EDIT To help the OP I built a sample file that has a button for a prompt and then tests the string.

Upvotes: 0

Dy.Lee
Dy.Lee

Reputation: 7567

Use Exit event

Private Sub TextBoxHour_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If IsDate(TextBoxHour.Value) And Len(TextBoxHour.Text) = 5 Then
        Else
            MsgBox "Input Hour like this Example 05:35"
            TextBoxHour.Text = ""
        End If
End Sub

Upvotes: 1

Related Questions