asked on

VBA: Do Loop with Input Box

I have a procedure which checks for the correct time. The return value should be the time/value entered.

The function checks convert the time from a x.xx format to a x:xx format as some people here enter the time with a dot/full stop.
I have boolean variable which, if the value is incorrect, should be set to false. The loop should iterate until a correct value is entered with an input box and the variable is set to true.

I cannot make the input box appear, that is the loop doesn't seem to work properly. What am I doing wrong?

Thanks for your help.

mscola

Function IsTime(sTime As String) As String

Dim ValidEntry As Boolean
Dim ValueToCheck As String

ValueToCheck = Replace(sTime, ".", ":")

Do While ValidEntry = True

'is it a time?
If Not IsDate(ValueToCheck) And CDbl(ValueToCheck) < 1 Then

 ValueToCheck = InputBox("Please enter a correct time", "")
 ValidEntry = False
 
Else
    ValidEntry = True
End If


Loop

IsTime = ValueToCheck


End Function

Open in new window

Ryan Chong

try make ur "function" as a "Sub" instead.

Rgonzo1971

Hi,

pls try

Function IsTime(sTime As String) As String

Dim ValidEntry As Boolean
Dim ValueToCheck As String

ValueToCheck = Replace(sTime, ".", ":")

Do

'is it a time?
On Error Resume Next
bRes = IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)
On Error GoTo 0
If bRes = False Then

 ValueToCheck = InputBox("Please enter a correct time", "")
 ValidEntry = False
 
Else
    ValidEntry = True
End If


Loop While ValidEntry = False

IsTime = ValueToCheck

End Function

Sub macro()
Var = IsTime("aa")
End Sub

Open in new window

Regards

Rgonzo1971

Or maybe like this

Function IsTime(ByVal sTime As String) As Boolean

Dim ValueToCheck As String

ValueToCheck = Replace(sTime, ".", ":")

On Error Resume Next
bRes = IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)
On Error GoTo 0
IsTime = bRes

End Function

Sub macro()
Do
ValToCheck = InputBox("Please enter a correct time", "")
Loop Until IsTime(ValToCheck) = True
End Sub

Open in new window

Massimo Scola

ASKER

I assume that in both examples in

bRes = IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)

bRes is a boolean variable

That is where the code stops and throws an error.

My idea is to add this code (in a module) on a control's exit.

Is it just my impression or am I trying to do which cannot be done?

Rgonzo1971

Yes bRes is a Boolean
does it stop even with on error resume next

if it is on a exit you should use it to cancel the exit

Private Sub myTime_Exit(Cancel As Integer)
If IsTime(myTime.Text) = False Then
    Cancel = True ' Cancel exit.
Else
    Exit Sub ' Save changes and exit.
End If
End Sub

Open in new window

Massimo Scola

ASKER

Yes, even with an error resume next in your second example.

I entered non-numerical values on purpose and I called it from the command prompt. That should work as well, shouldn't it?

VBA doesn't seem to like
myTime_Exit(Cancel As Integer)

the default is
_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Rgonzo1971

then goto

The Visual Basic Editor
Tools / Options
General (Tab)
Error Trapping
Change to
Break on Unhandled Errors and try again

Corrected code

Private Sub myTime_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsTime(myTime.Text) = False Then
    Cancel = True ' Cancel exit.
Else
    Exit Sub ' Save changes and exit.
End If
End Sub

Open in new window

Massimo Scola

ASKER

I've changed the error trapping and I've put your code in the exit handler.

On error, the input box does not pop up and I can't set focus to another control.

However, I can change the background colour and create a message box.
It'd be happy with this solution. However,

ValueToCheck = Replace(sTime, ".", ":")

doesn't work. So 13.30 is still considered an error.

Rgonzo1971

Could you send your code?

the exit sub and the isdate code

Massimo Scola

ASKER

Here is the code with the userform.
TimeError.xlsm

Rgonzo1971

then try to replace the . with : on the exit function

Function IsTime(ByVal sTime As String) As Boolean

Dim ValueToCheck                        As String
Dim bRes                                As Boolean

ValueToCheck = sTime

On Error Resume Next
bRes = IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)
On Error GoTo 0
IsTime = bRes

End Function

Open in new window

and

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Text = Replace(TextBox1.Text, ".", ":")
If IsTime(TextBox1.Text) = False Then
    Cancel = True ' Cancel exit.
Else
    Exit Sub ' Save changes and exit.
End If
End Sub

Open in new window

TimeError.xlsm

Massimo Scola

ASKER

The problem is that as soon as I enter a non-numerical character IsDate() throws an error.

bRes = IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)

Open in new window

I also changed it to

bRes = IsNumeric(sTime") And IsDate(TimeValue(ValueToCheck)) And (CDbl(TimeValue(ValueToCheck)) < 1)

Open in new window

but then I can't move the courser in the textbox.

So I assume that I need to check whether the value sTime contains numeric values with ":" only first; then exit the function.

Is this a good idea?

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Massimo Scola

ASKER

This works.

The userform works now. If there is an error, the user won't be able to set focus to another object.
I can also add an error message and change the background colour of the object to make the user aware of the error.

Thanks!

mscola