PDA

View Full Version : [SOLVED:] Data Validation in a MessageBox - VBA



gratefulwork
10-23-2018, 01:56 PM
Hi there,

In Excel VBA, I have a message box that must only accept negative, odd, double digit numbers, and then sum all numbers from the inputted number to zero. I have taken a portion of code from online and have been trying to modify it to my situation. So far, I am able to get the negative portion to work, so the input only accepts negative numbers. I have also been able to get even numbers on with Mod 2 = 0, however Mod 2 = 1 does not change it is odd numbers only. As well, I have no idea how to go about having the message box only accept double digit numbers. I think it has something to do with Len(2) but I am unsure how to implement it.

I have attached my workbook below. Any help is greatly appreciated.

23079

Paul_Hossler
10-23-2018, 05:46 PM
I'd do something like this

I prefer to have 'byte-size' value tests

I also added (at least for my testing) an 'escape' value of 0




Option Explicit

Sub NegativeOddInteger()
Dim Sum As Double
Dim NumberInput As Variant
Dim x As Double
Dim NumberOK As Boolean

NumberOK = False

On Error GoTo BadInput

Do

GetNumber:
NumberInput = InputBox("Please Enter a Negative Odd Double Digit Integer, '0' to Exit")

If NumberInput = 0 Then Exit Sub

If Not IsNumeric(NumberInput) Then Err.Raise 1000, "NegativeOddInteger", "Not a number"
If NumberInput >= 0 Then Err.Raise 1001, "NegativeOddInteger", "Not negative"
If Abs(Int(NumberInput)) <> Abs(NumberInput) Then Err.Raise 1002, "NegativeOddInteger", "Not an integer"
If Abs(NumberInput) Mod 2 <> 1 Then Err.Raise 1003, "NegativeOddInteger", "Not odd"
If NumberInput < -99 Or NumberInput > -10 Then Err.Raise 1004, "NegativeOddInteger", "Not 2 digits"

NumberOK = True

Loop Until NumberOK

For x = NumberInput To 0 Step 2 'This sums numbers from input to zero, doing odds only.
Sum = Sum + x
Next

MsgBox ("This equals " & Sum) & vbCrLf & ("based on the inputted number of ") & NumberInput

Exit Sub

BadInput:
MsgBox Err.Description & " (" & Err.Number & ") Try again"
Resume GetNumber
End Sub

gratefulwork
10-24-2018, 06:49 PM
Thank you so much! The code worked perfectly.