Clean textbox Procedure in Userform

K

Kamolga

Well-known Member
Joined
Jan 28, 2015
Messages
1,185
Hi,

I have set up quite a long formatting procedure to enter time quickly (12 is 12:00) and correcting my common keyboard mistakes (7,45 for 07:45). It works fine but I have many boxes in different userforms and copy pasting every time get procedure huge and unreadable. For some reasons I don't succeed in having a macro called
Sub ForceTimeFormatting () which would be the blue lines of following code that I could recall from mytextbox_Beforeupdate and aligning myInput and myOutput to textbox.value. Here is my code
Code: 
Private Sub TxtObsStart_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Correct wrong format
[COLOR=#0000cd]Dim myInput As String
Dim myOutput As Variant
[/COLOR][COLOR=#ff0000]myInput = TxtObsStart.Value[/COLOR][COLOR=#0000cd]
myInput = Replace(myInput, ",5", ":30")
myInput = Replace(myInput, ",25", ":15")
myInput = Replace(myInput, ",75", ":45")
myInput = Replace(myInput, ".5", ":30")
myInput = Replace(myInput, ".25", ":15")
myInput = Replace(myInput, ".75", ":45")
myInput = Replace(myInput, ",", ":")
myInput = Replace(myInput, ".", ":")
myInput = Replace(myInput, "?", ":")
myInput = Replace(myInput, "/", ":")
myInput = Replace(myInput, "=", ":")
myInput = Replace(myInput, "+", ":")
Select Case Len(myInput)
    Case 1
        myOutput = "0" & myInput & ":00"
    Case 2
         Select Case InStr(myInput, ":")
            Case 0
                 myOutput = myInput & ":00"
            Case 1
                 myOutput = "00" & myInput & "0"
            Case 2
                 myOutput = "0" & myInput & "00"
    Case 3
        Select Case InStr(myInput, ":")
            Case 0
                 myOutput = "0" & Left(myInput, 1) & ":" & Right(myInput, 2)
            Case 1
                 myOutput = "00" & myInput
            Case 2
                 myOutput = "0" & myInput & "0"
            Case 3
                 myOutput = myInput & "00"
        End Select
    Case 4
        Select Case InStr(myInput, ":")
            Case 0
                 myOutput = Left(myInput, 2) & ":" & Right(myInput, 2)
            Case 1
                 GoTo NoChange
            Case 2
                 myOutput = "0" & myInput
            Case 3
                 myOutput = myInput & "0"
            Case 4
                 GoTo NoChange
        End Select
    Case Else
NoChange:
        myOutput = myInput
End Select
[/COLOR][COLOR=#ff0000]Me.TxtObsStart = myOutput[/COLOR]
'Force time format
If Not Me.TxtObsStart Like "??:??" Then
MsgBox "Please use format 'hh:mm'"
TxtObsStart.SetFocus
Cancel = True
Exit Sub
End If
ObsStart = Application.WorksheetFunction.Text(Me.TxtObsStart, "hh:mm")
Me.TxtObsStart = ObsStart
End Sub

My problem is to set up the red lines for each TextBox. Do I have to declare myinput as global variant or something like that?
 
Last edited:

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Sort by date Sort by votes
Wouldn't it be easier to place this in a function of it's own that cleans any string value and returns the cleaned up string? That way you can call it from each individual text box that needs it.
 
Upvote 0
Exactly what I try to do. I would like to input the text, then before updating the textbox, I would call the function (saved in a module?)
Code: 
[LEFT][FONT=Verdana]Sub ForceTimeFormatting ()
[FONT=Consolas][COLOR=#0000cd]Dim myInput As String
Dim myOutput As Variant
[/COLOR][/FONT][COLOR=#ff0000]MyInput = ???[/COLOR][COLOR=#0000cd][LEFT][COLOR=#0000cd][FONT=monospace]
myInput = Replace(myInput, ",5", ":30")
myInput = Replace(myInput, ",25", ":15")
myInput = Replace(myInput, ",75", ":45")
myInput = Replace(myInput, ".5", ":30")
myInput = Replace(myInput, ".25", ":15")
myInput = Replace(myInput, ".75", ":45")
myInput = Replace(myInput, ",", ":")
myInput = Replace(myInput, ".", ":")
myInput = Replace(myInput, "?", ":")
myInput = Replace(myInput, "/", ":")
myInput = Replace(myInput, "=", ":")
myInput = Replace(myInput, "+", ":")
Select Case Len(myInput)
    Case 1
        myOutput = "0" & myInput & ":00"
    Case 2
         Select Case InStr(myInput, ":")
            Case 0
                 myOutput = myInput & ":00"
            Case 1
                 myOutput = "00" & myInput & "0"
            Case 2
                 myOutput = "0" & myInput & "00"
    Case 3
        Select Case InStr(myInput, ":")
            Case 0
                 myOutput = "0" & Left(myInput, 1) & ":" & Right(myInput, 2)
            Case 1
                 myOutput = "00" & myInput
            Case 2
                 myOutput = "0" & myInput & "0"
            Case 3
                 myOutput = myInput & "00"
        End Select
    Case 4
        Select Case InStr(myInput, ":")
            Case 0
                 myOutput = Left(myInput, 2) & ":" & Right(myInput, 2)
            Case 1
                 GoTo NoChange
            Case 2
                 myOutput = "0" & myInput
            Case 3
                 myOutput = myInput & "0"
            Case 4
                 GoTo NoChange
        End Select
    Case Else
NoChange:
        myOutput = myInput
End Select
End Sub
[/FONT][/COLOR][/LEFT]
[/COLOR][B][I][U][SUB][SUP]<strike>
</strike>[/SUP][/SUB][/U][/I][/B][/FONT][/LEFT]
Code: 
[LEFT][COLOR=#333333][FONT=monospace]Private Sub TxtObsStart_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Call [COLOR=#222222][FONT=Verdana]ForceTimeFormatting[/FONT][/COLOR][COLOR=#ff0000]
Me.TxtObsStart = myOutput[/COLOR][LEFT][COLOR=#333333][FONT=monospace]
'Force time format
If Not Me.TxtObsStart Like "??:??" Then
MsgBox "Please use format 'hh:mm'"
TxtObsStart.SetFocus
Cancel = True
Exit Sub
End If
ObsStart = Application.WorksheetFunction.Text(Me.TxtObsStart, "hh:mm")
Me.TxtObsStart = ObsStart
[/FONT][/COLOR][/LEFT]
End Sub
[/FONT][/COLOR][/LEFT]
and then I have textbpx_change to use the data everywhere in the workbook.
​
I think my issue is to use Userform data in a module and module data in a usrform
 
Last edited:
Upvote 0
Correct - in a module. I personally would write it as a function that accepts a string argument and returns the cleaned version.

Out of interest is your text box an active x text box or a form text box?
 
Upvote 0
I'm a little confused on a couple of points. But firstly:

This code

Code: 
    If Not myString Like "??:??" Then
        MsgBox "Please use format 'hh:mm'"
        Cancel = True
        Exit Function
    End If

If you validated the text box with this first, wouldn't much of the cleaning sub be redundant?
 
Upvote 0
Correct - in a module. I personally would write it as a function that accepts a string argument and returns the cleaned version.​
Click to expand...

Oh yes, a UDF! I did not catch it on the first reading. That works perfectly :) I tried global variant previously but the output was not stable.

Out of interest is your text box an active x text box or a form text box?​
Click to expand...

Those are in userforms, no activeX.

This code

Code:
If Not myString Like "??:??" Then
MsgBox "Please use format 'hh:mm'"
Cancel = True
Exit Function
End If
If you validated the text box with this first, wouldn't much of the cleaning sub be redundant?​
Click to expand...

Now that I use the cleaning function, I have indeed barely any message coming but you can still use alphabetic or special caracters, leave it empty and so on. If someone writes 111:00 for 11:00, the cleaning is not working. Function does not consider AM/PM either for example.
 
Upvote 0
If ever someone needs to understand or wants to correct and force time input in a textbox, I have this
Code: 
Function FormatToTime(myInput As String) As String
Dim myOutput As Variant
myInput = Replace(myInput, ",5", ":30")
myInput = Replace(myInput, ",25", ":15")
myInput = Replace(myInput, ",75", ":45")
myInput = Replace(myInput, ".5", ":30")
myInput = Replace(myInput, ".25", ":15")
myInput = Replace(myInput, ".75", ":45")
myInput = Replace(myInput, ",", ":")
myInput = Replace(myInput, ".", ":")
myInput = Replace(myInput, "?", ":")
myInput = Replace(myInput, "/", ":")
myInput = Replace(myInput, "=", ":")
myInput = Replace(myInput, "+", ":")
 Select Case Len(myInput)
    Case 1
         myOutput = "0" & myInput & ":00"
    Case 2
         Select Case InStr(myInput, ":")
            Case 0
                 myOutput = myInput & ":00"
            Case 1
                 myOutput = "00" & myInput & "0"
            Case 2
                 myOutput = "0" & myInput & "00"
         End Select
    Case 3
         Select Case InStr(myInput, ":")
            Case 0
                 myOutput = "0" & Left(myInput, 1) & ":" & Right(myInput, 2)
            Case 1
                 myOutput = "00" & myInput
            Case 2
                 myOutput = "0" & myInput & "0"
            Case 3
                 myOutput = myInput & "00"
         End Select
    Case 4
         Select Case InStr(myInput, ":")
            Case 0
                 myOutput = Left(myInput, 2) & ":" & Right(myInput, 2)
            Case 1
                 GoTo NoChange
            Case 2
                 myOutput = "0" & myInput
            Case 3
                 myOutput = myInput & "0"
            Case 4
                 GoTo NoChange
         End Select
    Case Else
NoChange:
        myOutput = myInput
 End Select
FormatToTime = myOutput
End Function
in a standard module and the following in my userform
Code: 
Private Sub TxtObsStart_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'Correct wrong format
TxtObsStart = FormatToTime(TxtObsStart)
'Force time format
If Not Me.TxtObsStart Like "??:??" Then
MsgBox "Please use 24h format 'hh:mm'"
TxtObsStart.SetFocus
Cancel = True
Exit Sub
End If
'Time is accepted
ObsStart = Application.WorksheetFunction.Text(Me.TxtObsStart, "hh:mm")
Me.TxtObsStart = ObsStart
End Sub


Private Sub TxtObsStart_Change()
'Error when deleting to replace time
On Error Resume Next
'Put the value in Named range (hidden list Sheet)
Range("TSObs") = TxtObsStart.Value
'Calculate and show new timeframe on userform (e.g. Observation 04:00)
'Call g_update
'LblObs.Caption = "Observation " & g_Obstime
On Error GoTo 0
End Sub
and it works :)
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Userform inconsistent responses
Replies
1
Views
194
Candyman8019
C
WildBurrow
  • Solved
Userform write to multiple textboxes on specific pages
Replies
2
Views
192
WildBurrow
WildBurrow
V
  • Solved
VBA search in listbox when used combobox and textbox-To be modified
2
Replies
13
Views
973
velu888
V
G
  • Solved
run VBA when clicked
Replies
4
Views
116
Gylle
G
S
  • Question Question
Change date format inside textbox userform
Replies
1
Views
265
Akuini
Akuini

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top