My current code is checking for either lengthListbox or lengthListbox2 to have a selection or it will display an error message. What's the easiest way to make it so it is a selection from either lengthListbox or lengthListbox2 or the message "Please enter project length" will be displayed?
Function CheckInputs() As Boolean
If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
If Not CheckControl(Me.audienceCombobox, "Please select an Audience") Then Exit Function
If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
If Not CheckControl(Me.lengthListbox, "Please select a current year month") Then Exit Function
If Not CheckControl(Me.lengthListbox2, "Please select a next year month") Then Exit Function
CheckInputs = True
End Function
Private Function CountSelectedListBoxItems(lb As MSForms.ListBox) As Long
Dim i As Long
With lb
For i = 0 To .ListCount - 1
If .Selected(i) Then CountSelectedListBoxItems = CountSelectedListBoxItems + 1
Next i
End With
End Function
Function CheckControl(ctrl As MSForms.Control, errMsg As String) As Boolean
Select Case TypeName(ctrl)
Case "TextBox"
CheckControl = Trim(ctrl.Value) <> ""
Case "ComboBox"
CheckControl = ctrl.ListIndex <> -1
Case "ListBox"
CheckControl = CountSelectedListBoxItems(ctrl) > 0
' Case Else
End Select
If CheckControl Then Exit Function
ctrl.SetFocus
MsgBox errMsg
End Function
Some things I've tried:
Trying to enter an error check in the enter button
Private Sub enterButton_Click()
If Me.lengthListbox.ListIndex = -1 And Me.lengthListbox2.ListIndex = -1 Then
MsgBox "Please enter Project Length"
End If
If Not CheckInputs Then Exit Sub 'check for fields to have values
Process GetWs(Me.impactCombobox.Value) ' process data passing the proper worksheet got from GetWs() function
MsgBox "Project Entered Successfully"
ClearUFData 'clear the data
End Sub
I've also tried making a separate subfunction that is meant for checking listboxes only but couldn't make it work within CheckInputs
try two functions little modifications:
1) nest the listboxes checks (see last line before CheckInputs = True)
Function CheckInputs() As Boolean
If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
If Not CheckControl(Me.audienceCombobox, "Please select an Audience") Then Exit Function
If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
If Not CheckControl(Me.lengthListbox, "") Then If Not CheckControl(Me.lengthListbox2, "Please enter project length") Then Exit Function
CheckInputs = True
End Function
so that the first listbox possible negative check will have the second listbox check decide about the "exit"
2) slightly modify CheckControl (see first line right after End Select)
Function CheckControl(ctrl As msforms.Control, errMsg As String) As Boolean
Select Case TypeName(ctrl)
Case "TextBox"
CheckControl = Trim(ctrl.Value) <> ""
Case "ComboBox"
CheckControl = ctrl.ListIndex <> -1
Case "ListBox"
CheckControl = CountSelectedListBoxItems(ctrl) > 0
' Case Else
End Select
If errMsg = "" Then Exit Function
If CheckControl Then Exit Function
ctrl.SetFocus
MsgBox errMsg
End Function
so that no action is taken if the passed error message string is a void one
Related
I made a coding about calculation, there are 2 numbers in the 2 different 2 boxes, when I calculate the answer is wrong, there is a msgbox shown "Try again", if correct, the msgbox shown "you are correct", but is insert nothing or words then press enter, it will be shown error.
I want if the inputbox insert nothing then press enter, the inputbox will be shown again to restrick someone insert something into the inputbox and can not insert any words into the inputbox, if insert any words, also the inputbox will be shown again return to empty.
Does anyone can tell me how to solve this problem?
Thank you so much.
Dim a As String
Do While True
a = InputBox("Please enter your answer")
If a = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
Else
MsgBox("Try again!!!!")
End If
Loop
MsgBox("You are correct!")
End Sub
End Class
Dim a As String
Do While True
Do While a="" Or Not IsNumeric(a)
a = InputBox("Please enter your answer")
Done
If val(a) = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
Else
MsgBox("Try again!!!!")
End If
Loop
MsgBox("You are correct!")
InputBox in Do...Loop
Sub QnA()
Const Title As String = "Q&A"
Dim Answer As String
Dim TryAgain As Long
Do
Answer = InputBox("Please enter your answer", Title, "")
If Len(Answer) = 0 Then
MsgBox "Nothing entered.", vbExclamation, Title
Exit Sub
End If
If IsNumeric(Answer) Then
If Val(Answer) = Val(txtnumber1.Text) + Val(txtnumber2.Text) Then
Exit Do
End If
End If
TryAgain = MsgBox("Wrong answer (""" & Answer & """). Try again?", _
vbYesNo + vbQuestion, Title)
If TryAgain = vbNo Then Exit Sub
Loop
MsgBox "You are correct!", vbInformation, Title
End Sub
I am trying to create a database for part locations. Three of the fields (JobNumber, PartNumber and Location) are required fields and I have an If statement written to check for Nulls and error handling to give a message box. After the message box is closed, it will let me return to the form but it will not allow me to edit the field again AND it still adds the incomplete data to the table. Any advice?
Private Sub cmdAddNew_Click()
If IsNull(Me.JobNumber) Then
GoTo cmdAddNew_Click_Err
ElseIf IsNull(Me.PartNumber) Then
GoTo cmdAddNew_Click_Err
ElseIf IsNull(Me.Location) Then
GoTo cmdAddNew_Click_Err
End If
On Error GoTo cmdAddNew_Click_Err
On Error Resume Next
DoCmd.GoToRecord , "", acNewRec
If (MacroError <> 0) Then
Beep
MsgBox MacroError.Description, vbOKOnly, ""
End If
cmdAddNew_Click_Exit:
Exit Sub
cmdAddNew_Click_Err:
MsgBox "Job Number, Part Number and Location are required."
End Sub
Adding Cancel = True in your second if statement should fix this.
Private Sub cmdAddNew_Click()
If IsNull(Me.JobNumber) Then
GoTo cmdAddNew_Click_Err
ElseIf IsNull(Me.PartNumber) Then
GoTo cmdAddNew_Click_Err
ElseIf IsNull(Me.Location) Then
GoTo cmdAddNew_Click_Err
End If
On Error GoTo cmdAddNew_Click_Err
On Error Resume Next
DoCmd.GoToRecord , "", acNewRec
If (MacroError <> 0) Then
Beep
MsgBox MacroError.Description, vbOKOnly, ""
Cancel = True
End If
cmdAddNew_Click_Exit:
Exit Sub
cmdAddNew_Click_Err:
MsgBox "Job Number, Part Number and Location are required."
End Sub
Alternatively, you could define functions to check for a null value and return a boolean result:
Function isvalid(Field as string) As Boolean
If IsNull(field)
isvalid = False
Else
isvalid = True
End If
End Function
Sub Check_valid()
Call isvalid(field 1)
Call isvalid(f2)
Call isvalid(f3)
If isvalid(field 1) = false Or isvalid(f2) = false Or isvalid(f3) = false Then
msgbox "Job Number, Part Number and Location are required."
Exit Sub
End If
End Sub
Hope this helps!
I am new on VBA. I want to put some restrictions on my inputs in the UserForm. I want My variable to be a number (the user should select the row Number) and if she/he put text or leave it blank an error message should appear. This is the code I have:
Public Sub AddPolicy_Click()
Dim RowNumber As Integer
RowNumber = TextBox1.Value
If RowNumber = "" Then
MsgBox "Error Row Number- enter a value!", vbOKCancel + vbCritical, "Error"
ElseIf VarType(RowNumber) = vbString Then
MsgBox "Error Row Number- enter a Numerical Value!", vbOKCancel + vbCritical, "Error"
End If
Range("A1") = RowNumber
End Sub
I know that the problem is because I declare my variable RowNumber as an Integer, But if I do not do that the software does not recognize my variable, and show me the error message for text, blank and number. SO I do not know how can I solve this.
Thank you in advance for your help
How about this?
Public Sub AddPolicy_Click()
Dim RowNumber As String
RowNumber = TextBox1.Value
If RowNumber = "" Then
MsgBox "Error Row Number- enter a value!", vbOKCancel + vbCritical, "Error"
ElseIf Not IsNumeric(RowNumber) Then
MsgBox "Error Row Number- enter a Numerical Value!", vbOKCancel + vbCritical, "Error"
End If
Range("A1") = RowNumber
End Sub
Edit: About the declaration of String, integer etc.: I know people tend to be very particular about this. But it really doesnt make a difference efficiency-wise for most macros. Here for example you wont gain anything by declaring it better. Even simply not dim'ing it would work nicely.
You could try this code.
The change event on the textbox will stop you being able to enter anything except numerics.
Private LastText As String '<-- place this at the very top of the module.
Private Sub TextBox1_Change()
With Me.TextBox1
'Allow only whole numbers.
If .Text Like "[!0-9]" Or Val(.Text) < -1 Or .Text Like "?*[!0-9]*" Then
.Text = LastText
Else
LastText = .Text
End If
End With
End Sub
Private Sub TextBox1_AfterUpdate()
'Remove any leading or trailing spaces
'(although the Change event should stop you entering spaces).
Me.TextBox1 = Trim(Me.TextBox1)
End Sub
Private Sub AddPolicy_Click()
With Me.TextBox1
If .Value <> "" Then
'Fully qualify where you want to put the data, or it will
'put it in A1 of whichever sheet happens to be active.
ThisWorkbook.Worksheets("Sheet1").Range("A1") = Me.TextBox1
Else
MsgBox "Invalid or no value entered.", vbCritical + vbOKOnly
End If
End With
End Sub
I have 6 CheckBoxes right now under an Audience category and want to make it so that they have to select at least 1 of the 6 CheckBoxes or an error message saying "Please select an Audience" will appear.
Right now with the code below, the project will still be entered regardless of if they check one of the 6 boxes or not.
My current code looks like:
Function CheckInputs() As Boolean
If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
If Not CheckControl(Me.initiativeCombobox, "Please select an Initiative") Then Exit Function
If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
If Not CheckControl(Me.lengthListbox, "") Then If Not CheckControl(Me.lengthListbox2, "Please enter project length") Then Exit Function
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
CheckInputs = True
End Function
Private Function CountSelectedListBoxItems(lb As MSForms.ListBox) As Long
Dim i As Long
With lb
For i = 0 To .ListCount - 1
If .Selected(i) Then CountSelectedListBoxItems = CountSelectedListBoxItems + 1
Next i
End With
End Function
Function CheckControl(ctrl As MSForms.Control, errMsg As String) As Boolean
Select Case TypeName(ctrl)
Case "TextBox"
CheckControl = Trim(ctrl.Value) <> ""
Case "ComboBox"
CheckControl = ctrl.ListIndex <> -1
Case "ListBox"
CheckControl = CountSelectedListBoxItems(ctrl) > 0
Case "CheckBox"
CheckControl = ctrl.Value = False
' Case Else
End Select
If errMsg = "" Then Exit Function
If CheckControl Then Exit Function
ctrl.SetFocus
MsgBox errMsg
End Function
Would setting a CheckControl function for CheckBox as ctrl.Value = False be the appropriate route? Or did I not set my CheckInputs function correctly?
Yes, it seems to me that (if I understand correctly) your CheckInputs function is currently incorrect.
The following line of code:
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
needs to be change to the following:
If UserForm1.rvpCheckbox.Value = False And _
UserForm1.umCheckbox.Value = False And _
UserForm1.uwCheckbox.Value = False And _
UserForm1.baCheckbox.Value = False And _
UserForm1.uaCheckbox.Value = False And _
UserForm1.otherCheckbox.Value = False Then
UserForm1.otherCheckbox.Caption = "Please select an Audience"
'...or maybe a message box instead?
MsgBox "Please select an Audience"
Exit Function
End If
need help with the yes no portion of the error message, if yes I want the code to be launched again and if no then exit sub.
Public Sub Reset()
Dim pt As PivotTable
Dim slice As Slicer
Application.ScreenUpdating = False
ActiveWorkbook.Model.Refresh
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
For Each slice In pt.Slicers
slice.SlicerCache.ClearAllFilters
On Error GoTo 0
Next slice
pt.PivotCache.Refresh
Next pt
Error 0:
MsgBox "Sorry, Missing data, do you wish to continue?", _
vbCritical vbYesNo, "Restart process!"
Select Case vbYesNo
Case yes
MergeMultipleSheets
Case Else
Exit Sub
End Select
Application.ScreenUpdating = True
End Sub
Here is yes no portion of your code (assuming that you want to launch module MergeMultipleSheets if yes button is clicked):
Sub Reset()
Dim xlAns As Integer
xlAns = MsgBox("Sorry, Missing data, do you wish to continue?", vbYesNo, "Restart process!")
Select Case xlAns
Case vbYes
' do something
' if You want to call sub MergeMultipleSheets
MergeMultipleSheets
Case Else
' do something
Exit Sub
End Select
End Sub
Quick Example
Sub MsgBx()
Dim xlMsgBox As Integer
Dim Cancel As Boolean
xlMsgBox = MsgBox("Do you want to do this ", vbYesNoCancel)
If xlMsgBox = vbCancel Then
Cancel = True ' Exit
Exit Sub
ElseIf xlMsgBox = vbYes Then
' do something
ElseIf xlMsgBox = vbNo Then
' do something
End If
End Sub