I am trying to create a pop up question in powerpoint VBA, so far so good. But below code doesn’t seem to work. Idea is that you get a popup box with value to enter between 100 - 200 (inclusive). But must enter a value between or can accept failed as input. The inputbox cannot be cancelled or null/empty responses. The inner loop (loop 1) seems to work ok, but if I enter 150 it doesn't terminate the loop 2 instead keeps going unless type failed but it stops with any text rather than only "failed".
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
'Declare Variables
Dim xType, xLimitHi, xLimitLo, xPrompt As String
Dim InputvarTemp As String
Dim msgResult As Integer
xLimitHi = 200
xLimitLo = 100
xPrompt = "Enter Value between 100 and 200 (Inclusive)"
Do 'loop 2 check within limit or failed
msgResult = vbNo
Do 'loop 1 check Empty / Null or Cancelled input
InputvarTemp = InputBox(xPrompt, xPrompt)
If StrPtr(InputvarTemp) = 0 Then ' Check if cancelled is pressed
MsgBox "Invalid Input - Cannot be cancelled", 16, "Invalid Input."
Else
If Len(InputvarTemp) = 0 Then ' Check Null response
MsgBox "Invalid Input - Cannot be Empty / Null ", 16, "Invalid Input."
Else
msgResult = MsgBox("You have Entered " & InputvarTemp, vbYesNo + vbDefaultButton2, "Check Value in between " & xLimitLo & " to " & xLimitHi & "(Inclusive)")
If CDec(InputvarTemp) < 100 Or CDec(InputvarTemp) > 200 Then ' Check within Limits
MsgBox "Invalid Input - Not Within Limit", 16, "Invalid Input."
End If
End If
End If
Loop Until Len(InputvarTemp) > 0 And msgResult = vbYes And StrPtr(InputvarTemp) = 1 And IsNull(InputvarTemp) = False 'loop 1 check Empty / Null or Cancelled input
Loop Until CDec(InputvarTemp) >= 100 And CDec(InputvarTemp) <= 200 Or InputvarTemp = "Failed" 'loop 2 check within limit
Select Case InputvarTemp
Case "Failed"
MsgBox "Test Criteria Failed, Contact Production Engineer", 16, "Failed Test Criteria."
Case Else
MsgBox "Test Criteria Passed", 16, "Passed Test Criteria."
End Select
End Sub
Can anyone point me to the problem? Many thanks in advance. This is a part of a bigger code project but this part is not working I have isolated this code in to a single file to run by itself to figure out the issue.
To better understand what's going on, you need to write your code in such a way that it does as little as possible; right now you have a single procedure that does so many things it's hard to tell exactly what's going wrong and where.
Write a function to confirm user's valid numeric input:
Private Function ConfirmUserInput(ByVal input As Integer) As Boolean
ConfirmUserInput = MsgBox("Confirm value: " & CStr(input) & "?", vbYesNo) = vbYes
End Function
Then write a function to deal with user's input:
Private Function IsValidUserInput(ByVal userInput As String,_
ByVal lowerLimit As Double, _
ByVal upperLimit As Double) _
As Boolean
Dim result As Boolean
Dim numericInput As Double
If StrPtr(userInput) = 0 Then
'msgbox / cannot cancel out
ElseIf userInput = vbNullString Then
'msgbox / invalid empty input
ElseIf Not IsNumeric(userInput) Then
'msgbox / must be a number
Else
numericInput = CDbl(userInput)
If numericInput < lowerLimit Or numericInput > upperLimit Then
'msgbox / must be within range
Else
result = ConfirmUserInput(numericInput)
End If
End If
IsValidUserInput = result
End Function
This function can probably be written in a better way, but nonetheless it will return False if any of the validation rules fail, or if user doesn't confirm their valid input. Now you're equipped for looping, and since all the complex logic is extracted into its own function, the loop body gets pretty easy to follow:
Private Function GetTestCriteria(ByVal lowerLimit As Double, _
ByVal upperLimit As Double) As Boolean
Const failed As String = "Failed"
Dim prompt As String
prompt = "Enter Value between " & lowerLimit & _
" and " & upperLimit & " (Inclusive)."
Dim userInput As String
Dim isValid As Boolean
Do
userInput = InputBox(prompt, prompt)
isValid = IsValidUserInput(userInput, lowerLimit, upperLimit) _
Or userInput = failed
Loop Until IsValid
GetTestCriteria = (userInput <> failed)
End Sub
The OnSlideShowPageChange procedure can now look like this:
Private Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
If GetTestCriteria(100, 200) Then
MsgBox "Test criteria passed."
Else
MsgBox "Test criteria failed, contact production engineer."
End If
End Sub
I haven't tested any of this code, but I'm sure debugging these more specialized functions will be easier than debugging your monolithic chunk of code; by extracting these functions, you untangle the logic, and I bet the above does exactly what you're trying to do. Also note:
Dim xType, xLimitHi, xLimitLo, xPrompt As String declares xPrompt as a String, and everything else as a Variant. I don't think that's your intent here.Select Case is best used with Enum values; use If-ElseIf constructs otherwise.Slight modifications, per below comment:
how do i capture the user input to do something like write to a file
Now if you wanted to do something with the valid user inputs, say, write them to a file, you'd need GetTestCriteria to return the input - but that function is already returning a Boolean. One solution could be to use an "out" parameter:
Private Function GetTestCriteria(ByVal lowerLimit As Double, _
ByVal upperLimit As Double, _
ByRef outResult As Double) As Boolean
Const failed As String = "Failed"
Dim prompt As String
prompt = "Enter Value between " & lowerLimit & _
" and " & upperLimit & " (Inclusive)."
Dim userInput As String
Dim isValid As Boolean
Do
userInput = InputBox(prompt, prompt)
isValid = IsValidUserInput(userInput, lowerLimit, upperLimit, outResult) _
Or userInput = failed
Loop Until IsValid
GetTestCriteria = (userInput <> failed)
End Sub
Private Function IsValidUserInput(ByVal userInput As String,_
ByVal lowerLimit As Double, _
ByVal upperLimit As Double, _
ByRef outResult As Double) _
As Boolean
Dim result As Boolean
Dim numericInput As Double
If StrPtr(userInput) = 0 Then
'msgbox / cannot cancel out
ElseIf userInput = vbNullString Then
'msgbox / invalid empty input
ElseIf Not IsNumeric(userInput) Then
'msgbox / must be a number
Else
numericInput = CDbl(userInput)
If numericInput < lowerLimit Or numericInput > upperLimit Then
'msgbox / must be within range
Else
result = ConfirmUserInput(numericInput)
outResult = numericInput
End If
End If
IsValidUserInput = result
End Function
And now you can call a method in OnSlideShowPageChange, to write the valid result to a file:
Private Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim result As Double
If GetTestCriteria(100, 200, result) Then
MsgBox "Test criteria passed."
WriteResultToFile result
Else
MsgBox "Test criteria failed, contact production engineer."
End If
End Sub
If you run into issues implementing this WriteResultToFile procedure, and existing Stack Overflow questions don't have an answer for you (slightly unlikely), feel free to ask another question!