Input Box Cancel Button

[Olivia Grant]

I'm hoping this is an easy fix! I have an input box which works great but when the cancel button is clicked it brings up "Run-time error '13': Type mismatch". The code I am using is listed below. Any advise on how to have the cancel button just exit out of the message box?


Sub gethours()
Dim QtyEntry As Currency
Dim msg As String
msg = "Enter Pitched Amount"
QtyEntry = InputBox(msg)
Worksheets("overview").Range("H5").Value = QtyEntry
End Sub

 

[CharlesChuckieCharles]

Try something like

Sub gethours()
Dim MyResult As Variant
Dim QtyEntry As Variant
Dim msg As String
msg = "Enter Pitched Amount"
QtyEntry = ""
While Not IsNumeric(QtyEntry)
    MyResult = InputBox(msg)
    
    If MyResult = "" Then 'cancel pressed
      Exit Sub
    End If
    QtyEntry = MyResult
    
    If Not IsNumeric(QtyEntry) Then
      MsgBox "please enter a valid Currency amount"
    End If
Wend
If IsNumeric(QtyEntry) Then
  QtyEntry = Format(QtyEntry, "currency")
End If
Worksheets("overview").Range("H5").Value = QtyEntry
End Sub

 

[Olivia Grant]

Thanks! That solved the error problem and appreciate the message box for invalid entries.
I do have one other issue now - I need to automatically run a second macro but don't want it to run if the cancel button is hit. It is currently running whether "Ok" or "Cancel" is clicked.

Here is what I have:

Sub gethours()
Dim MyResult As Variant
Dim QtyEntry As Variant
Dim msg As String
msg = "Enter Pitched Amount"
QtyEntry = ""
While Not IsNumeric(QtyEntry)
MyResult = InputBox(msg)

If MyResult = "" Then 'cancel pressed
Exit Sub
End If
QtyEntry = MyResult

If Not IsNumeric(QtyEntry) Then
MsgBox "please enter a valid Currency amount"
End If
Wend
If IsNumeric(QtyEntry) Then
QtyEntry = Format(QtyEntry, "currency")
End If
Worksheets("overview").Range("H5").Value = QtyEntry

finalmove

End Sub

 

[Rick Rothstein]

Here is a generalized structure you can use for the InputBox that will allow you to react to the user clicking the Cancel button or clicking Enter without filling in anything as well as when the user enters actual data (replace the various MessageBoxes with the code appropriate to the indicated section)...

Dim Answer As String
 '....
 '....
 Answer = InputBox("Tell me something")
 If StrPtr(Answer) = 0 Then
   MsgBox "The user clicked Cancel, so we will exit the subroutine now."
   Exit Sub
 ElseIf Len(Answer) = 0 Then
   MsgBox "The user clicked OK without entering anything in the InputBox!"
 Else
   MsgBox "The user entered the following..." & vbLf & vbLf & Answer
 End If

 

[CharlesChuckieCharles]

turn the sub into a function


You'll note how I've Change the Get hours a Bit using Ricks String pointer function


The Teststub code demonstrates how to use GetHours as a Function

Function GetHours() As Boolean
Dim MyResult As Variant
MyResult = ""
'preset result to failure
GetHours = False
'blank entry  and okay leave it locked in the loop  CANCEL has to be pressed to exit without valid entry
While Not IsNumeric(MyResult)
    MyResult = InputBox("Enter Pitched Amount")
    If StrPtr(MyResult) = 0 Then 'cancel pressed Courtesy of Mr Rothsteins String Pointer function
        Exit Function
    End If

    If Not IsNumeric(MyResult) Then
        MsgBox "Please enter a valid Currency amount"
    End If
Wend
Worksheets("sheet1").Range("H5").Value = Format(MyResult, "currency")
'????????????????????????????
'finalmove  ' whats this?
'??????????????????
'Set result to Success
GetHours = True
End Function

Sub teststub()
Dim bResult As Boolean

bResult = GetHours()
If bResult Then
  'run my macro
End If

End Sub