I have the following code :
Range("P" & Rows.Count).End(xlUp).offset(1).Value = InputBox("INTRODUCE ACT JUSTIFICATIV")
User must enter letters in inputbox
I want to prevent the user from accidentally pressing enter if value in inputbox is blank with a personalized error message.
And pressing cancel button to exit sub.
Set your Users input to a variable and then test to see whether it is valid or not.
Dim usrInput as String
Do
usrInput = InputBox("INTRODUCE ACT JUSTIFICATIV")
If usrInput = vbNullString Then
MsgBox "Your Error Message"
End If
Loop While usrInput = vbNullString
I don't think that you can force the InputBox to close only if something was entered. Instead, read the result into variable and loop until something valid was entered
Dim answer as string, okay As Boolean
answer = ""
okay = False
Do While Not okay
answer = InputBox("INTRODUCE ACT JUSTIFICATIV")
On Error Resume Next
okay = Range(answer & "1").Address <> ""
On Error GoTo 0
Loop
Now, the InputBox will pop up until a valid column was entered.
Try the next approach, please:
Sub testInputBoxValidate()
Dim strInpB As String
strInpB = InputBox("INTRODUCE ACT JUSTIFICATIV")
If strInpB = "" Then MsgBox "You did not introduce anything!": Exit Sub
Range("P" & Rows.count).End(xlUp).Offset(1).Value = strInpB
End Sub
And a variant to oblige the user inputting something:
Sub testInputBoxValidate()
Dim strInpB As String
Start:
strInpB = InputBox("INTRODUCE ACT JUSTIFICATIV")
If strInpB = "" Then MsgBox "You did not introduce anything!": GoTo Start
Range("P" & Rows.count).End(xlUp).Offset(1).Value = strInpB
End Sub
I would also suggest you to try some more other checking. For instance, that 'ACT JUSTIFICATIV' must not have a specific length (number of digits)? A specific pattern like `xxxx###', where '###' is a three (x) digits number?
You can use Application.InputBox which gives you a little more control. The user will be prompted until they either enter a non-blank string or press the cancel or x buttons
Dim vInput As Variant: vInput = ""
Do
vInput = Application.InputBox("INTRODUCE ACT JUSTIFICATIV", Type:=2) '2 -> String type
If vInput = False Then 'User pressed Cancel or x button
Exit Do
ElseIf Len(vInput) > 0 Then 'User has entered non-blank value
Range("P" & Rows.Count).End(xlUp).Offset(1).Value = vInput
Exit Do
End If
Loop
Related
I want to create a input box, and put the input into corresponding cells. But it show type mismatch.
Sub Profit_Projection()
Dim rng As Range
Dim psales As Integer
Dim msg1 As String
psales = InputBox("Please enter the predicted growth of sales next month in decimal form.", "Sales Growth", 1)
If StrPtr(psales) = 0 Then
MsgBox "You clicked Cancel button"
Exit Sub
ElseIf psales = "" Then
MsgBox "You didnt enter input"
Exit Sub
Else
Val (psales)
Range("B5") = psales * 100
If Range("B5").IsNumeric = False Then
msg1 = "The number inputted is is not integer. Please try again in decimal form."
MsgBox msg1, vbOKOnly, "Incorrect Input"
End If
End If
End Sub
Your main problem is that InputBox returns a String (see the official documentation), but you assign it to a numeric variable.
If the user enters some non-numeric data, you will get the type mismatch already at the psales = InputBox - statement.
If the user enters a numeric value, VBA will convert it into a number. But then you get a a type mismatch for the statement psales = "" because you cannot compare a number and a string (even if it is an empty string).
So you should assign the result of the InputBox first to a String variable and then check step by step if the entered value was okay:
Sub Profit_Projection()
Dim rng As Range
Dim psales As Integer
Dim answer
Dim msg1 As String
answer = InputBox("Please enter the predicted growth of sales next month in decimal form.", "Sales Growth", 1)
If StrPtr(answer) = 0 Then
MsgBox "You clicked Cancel button"
Exit Sub
End If
If Trim(answer) = "" Then
MsgBox "You didnt enter anything"
Exit Sub
End If
If Not IsNumeric(answer) Then
MsgBox "You didnt enter a number"
Exit Sub
End If
If CInt(answer) <> Val(answer) Then
MsgBox "You didnt enter an integer "
Exit Sub
End If
psales = Val(answer)
ActiveSheet.Range("B5") = psales * 100
End Sub
I am trying to run code to use sap_a and sap_b (both text boxes in a userform) to look up the variable 'Run'. I wrote the code so that the person entering the sap_a and sap_b values could enter the values in either box and the 'Run' variable would be found, which is why ErrorCheck1 exists. ErrorCheck2 exists simply to provide a message if the values in sap_a/b are unable to be matched with a 'Run' variable. The issue I'm having is that this code generates a 'Run' value even when one of the sap_a or sap_b values is not correct (i.e. sap_a is a value that does exist in the spreadsheet, sap_b is a fake value not existing in the spreadsheet, and a 'Run' variable is still produced). Do you have any input specifically regarding issues with my code or any issues you see? Code is attached.
Thank you!
Private Sub SearchButtonTEST_Click()
Dim sap_a As Variant
Dim sap_b As Variant
Dim Run_ As Variant
Sheets("R_Database Sheet").Activate
sap_a = textbox5.Value
sap_b = textbox8.Value
If sap_a = "" And sap_b = "" Then
Run_ = ""
Let textbox1.Text = Run_
Msgbox "Must enter SAP Codes in SAP # A and SAP # B to search."
Exit Sub
Else
Check1:
On Error GoTo ErrorCheck1
Run_ = Application.WorksheetFunction.Index(Sheets("R_Database Sheet").Range("A:A"), Application.WorksheetFunction.Match(CLng((sap_a)), Sheets("R_Database Sheet").Range("E:E"), Application.WorksheetFunction.Match(CLng((sap_b)), Sheets("R_database sheet").Range("H:H"), 0)))
Let textbox1.Text = Run_
Check2:
On Error GoTo ErrorCheck2
Run_ = Application.WorksheetFunction.Index(Sheets("R_Database Sheet").Range("A:A"), Application.WorksheetFunction.Match(CLng((sap_b)), Sheets("R_Database Sheet").Range("E:E"), Application.WorksheetFunction.Match(CLng((sap_a)), Sheets("R_database sheet").Range("H:H"), 0)))
Let textbox1.Text = Run_
Exit Sub
Check3:
Msgbox "No data found for specified SAP #'s."
End If
Exit Sub
ErrorCheck1:
Resume Check2
ErrorCheck2:
Resume Check3
End Sub
Your code will be easier to manage if you drop the Worksheetfunction and just use Application.Match
If you include the worksheetfunction then a run-time error is raised if there's no match (requiring tricky error handling). If you drop it, then a no-match just returns an error value which you can test using IsError(). Personally I find this much easier to manage.
Private Sub SearchButtonTEST_Click()
Dim sap_a As Variant, sap_b As Variant
Dim ws As Worksheet, mA, mB
Set ws = Sheets("R_Database Sheet")
sap_a = Trim(textbox5.Value)
sap_b = Trim(textbox8.Value)
If sap_a = "" And sap_b = "" Then
textbox1.Text = ""
MsgBox "Must enter SAP Codes in SAP # A and SAP # B to search."
Exit Sub
Else
mA = Application.Match(CLng(sap_a), ws.Range("E:E"), 0)
mB = Application.Match(CLng(sap_b), ws.Range("H:H"), 0)
If Not IsError(mA) Then
textbox1.Text = ws.Cells(mA, "A")
ElseIf Not IsError(mB) Then
textbox1.Text = ws.Cells(mB, "A")
Else
textbox1.Text = "Not found!"
End If
End If
End Sub
I am trying to create code that runs through a list of user ID's (B Numbers) and then when it finds the corresponding ID it checks to see if there's an X in the column directly next to it for a certain subject named SBB005 See image. If there is an X, I want the check box value to be true. The for each loop ends when it reaches a blank cell.
I have declared the 'RowYear2' and 'Year2CourseRange' ranges as public variables, and when running the code, nothing happens and the check box remains unticked! Any idea why the checkbox isn't being ticked as expected?
I am planning on setting up multiple checkboxes once this is working for all the subjects in each column:
See image
Hoping that someone can help me to get this working or may even introduce an easier way to do so for another 20 checkboxes!
Many thanks :)
Private Sub UserForm_Initialize()
Set Year2CourseRange = Sheets("Year2").Range("A:A")
For Each RowYear2 In Year2CourseRange.Cells
If RowYear2.Value = BNumberTxt Then
If RowYear2.Offset(0, 1) = "x" Then
Me.CHKSBB005.value = True
Else
Me.CHKSBB005.value = False
End If
ElseIf IsEmpty(RowYear2) Then
Exit For
End If
Next RowYear2
LoggedInTxt = Row.Offset(0, -3)
BNumberTxt = Row.Offset(0, -7)
CourseTxt = Row.Offset(0, -1)
CourseNumTxt = Row.Offset(0, -2)
End Sub
Private Sub EnterBtn_Click()
Dim LIMatch As Boolean
Dim Win As Boolean
Email = Me.EmailTxt
Password = Me.PasswordTxt
Set UserRange = Sheets("StudentInformation").Range("H:H")
For Each Row In UserRange.Cells
If Me.EmailTxt = "" And Me.PasswordTxt = "" Then
MsgBox ("Please enter an email and password")
LIMatch = False
Win = True
Exit For
ElseIf Me.EmailTxt = "" Then
MsgBox ("Please enter an email address")
LIMatch = False
Win = True
Exit For
ElseIf Me.PasswordTxt = "" Then
MsgBox ("Please enter a password")
LIMatch = False
Win = True
Exit For
Else
If UCase(Row.Value) = UCase(Email) Then
If UCase(Row.Offset(0, -6)) = UCase(Password) Then
MsgBox "Welcome"
LIMatch = True
Win = True
Attempts = 0
Exit For
ElseIf IsEmpty(Row) Then
Exit For
Win = False
Else
LIMatch = False
Win = False
Exit For
End If
Else
LIMatch = False
Win = False
End If
End If
Next Row
If LIMatch = True And Win = True Then
Unload Me
NewForm.Show
ElseIf LIMatch = False And Win = False Then
MsgBox ("Incorrect login")
Attempts = Attempts + 1
Else
End If
If Attempts >= 3 Then
MsgBox ("You have entered the incorrect login 3 times")
Unload Me
End If
End Sub
Once you fix your problem with the Row global, you can do something like this:
Private Sub UserForm_Initialize()
Dim shtData As Worksheet
Dim Year2CourseRange As Range, HeaderRange As Range, m, c As Range
Set shtData = ThisWorkbook.Sheets("Year2")
With shtData
Set Year2CourseRange = .Range("A:A")
Set HeaderRange = .Range(.Range("B2"), .Cells(2, 500).End(xlToLeft))
End With
'you'll need to fix this part....
BNumberTxt = Row.Offset(0, -7)
'etc
'find a matching row: Match() is a good approach here
m = Application.Match(BNumberTxt, Year2CourseRange, 0)
'loop over all the column headers
For Each c In HeaderRange.Cells
'Assumes all checkboxes are named "CHK[ColumnHeaderHere]"
With Me.Controls("CHK" & c.Value)
If IsError(m) Then
.Value = False 'clear all if no match
Else
.Value = (UCase(shtData.Cells(m, c.Column)) = "X") 'set if "x"
End If
End With
End If
End Sub
Ranges and Ranges
This is your code squashed a little bit and below is your data:
Private Sub UserForm_Initialize()
Set Year2CourseRange = Sheets("Year2").Range("A:A")
For Each RowYear2 In Year2CourseRange.Cells
If RowYear2.Value = BNumberTxt Then
If RowYear2.Offset(0, 1) = "x" Then
Me.CHKSBB005.value = True
Else: Me.CHKSBB005.value = False: End If
ElseIf IsEmpty(RowYear2) Then
Exit For: End If: Next RowYear2
LoggedInTxt = Row.Offset(0, -3): BNumberTxt = Row.Offset(0, -7)
CourseTxt = Row.Offset(0, -1): CourseNumTxt = Row.Offset(0, -2): End Sub
Take a look for a while, you might see the error yourself.
The CheckBox Tick Mystery
When you write Range("A:A") that refers to the whole column including Range("A1") which appears to be EMPTY. The code never even enters the If RowYear2.Offset... line but exits via the ElseIf line.
The Row Variable
I hate the idea of declaring a variable Row. But it is valid. Since there is an Offset involved, Row should be a range, probably a cell. As in the comments indicated, it has to 'survive' from another UserForm let's say UserFormX. If it has 'survived' you have to refer to it like this:
UserFormX.Row
or you have to declare it in a 'not-object' module to use only Row.
Another EnterBtn_Click
Probably useless now but here is the code I worked on the other day:
Option Explicit
Public intAttempts As Integer
Private Sub CancelBtn_Click()
Unload Me
End Sub
Private Sub EnterBtn_Click()
Const strEmail = "Please enter email address." ' Email Input Message
Const strPassword = "Please enter a password." ' Password Input Message
Const strLoginCorrect = "Welcome" ' Correct Login Message
Const strLoginIncorrect = "Incorrect Login." ' Incorrect Login Message
Const strAttempts = "Too many login attempts." ' Login Attempts Message
' Use worksheet name or index e.g. "SInfo" or 1.
Const vntWsName As String = "StudentInformation" ' Worksheet
' Use column letter or column number e.g. "F" or 6.
Const vntEmailColumn As Variant = "F" ' Email Column
Const intFirstRow As Integer = 2 ' Email Column First Row
Const intPasswordColumnOffset As Integer = -4 ' Password Column Offset
Const intMaxAttempts As Integer = 3 ' Maximum Login Attempts
Dim lngCounter As Long ' Email Column Row Counter
Dim lngLastrow As Long ' Email Column Last Row
' Check number of login attempts.
If intAttempts >= intMaxAttempts Then
MsgBox strAttempts
Exit Sub
End If
' Show annoying text messages if nothing was entered.
If Me.EmailTxt.Text = "" Then
Me.EmailTxt.Text = strEmail: Exit Sub
ElseIf Me.EmailTxt.Text = strEmail Then Exit Sub
End If
If Me.PasswordTxt.Text = "" Then
Me.PasswordTxt.Text = strPassword: Exit Sub
ElseIf Me.PasswordTxt.Text = strPassword Then Exit Sub
End If
' Check for data in specified worksheet.
With ThisWorkbook.Worksheets(vntWsName)
' Determine last row of data in Email Column.
lngLastrow = .Cells(Rows.Count, vntEmailColumn).End(xlUp).Row
For lngCounter = intFirstRow To lngLastrow
' Ceck for email in Email Column.
If UCase(.Cells(lngCounter, vntEmailColumn).Value) _
= UCase(EmailTxt.Text) Then ' Correct email.
' Check if correct password in Password Column
If UCase(.Cells(lngCounter, vntEmailColumn) _
.Offset(0, intPasswordColumnOffset).Value) _
= UCase(PasswordTxt.Text) Then ' Correct password.
Exit For
Else ' Wrong password. Set "counter" to "end".
' Faking that the loop was not interrupted.
lngCounter = lngLastrow
End If
' Else ' Wrong Email. Do nothing. Not necessary.
End If
Next
' When the loop wasn't interrupted, "lngcounter = lnglastrow + 1".
End With
' Check if loop was NOT interrupted.
If lngCounter = lngLastrow + 1 Then ' Loop was NOT interrupted.
intAttempts = intAttempts + 1
MsgBox strLoginIncorrect
Else ' Loop was interrupted. Correct email and password.
MsgBox strLoginCorrect
Unload Me
NewForm.Show
End If
End Sub
I'm having some trouble with an Excel VBA macro and was hoping you could give me some advice on how to fix it. In the code below, when a user clicks a command button, an InputBox pops up and the user inputs a number in the form XXX-XXXXXX (e.g. 111-222222). Then, the macro takes the value from the column adjacent to button and uses the input variable to replace a certain part of the adjacent column's value. However, when I tried to run the macro and input a number such as 123-456789, nothing happens. I believe it has something to do with the dash that the user inputs, however I'm not sure how to fix it. Please help!
Sub CommandButtonTitleXXXdashXXXXXX_Click()
Application.ScreenUpdating = False
On Error Resume Next
Dim n As Integer
n = Worksheets("REVISIONS").Range("D3:D17").Cells.SpecialCells(xlCellTypeConstants).Count
If n = 15 Then
If MsgBox("Title revision box full. Add manually.", vbOKOnly, "Error") = vbOK Then
Exit Sub
End If
End If
Dim rs As Integer
rs = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
Dim amount As String
Application.ScreenUpdating = True
amount = Application.InputBox("Enter case number:", "")
Application.ScreenUpdating = False
If amount = False Then
Exit Sub
Else
Dim newCell As String
newCell = Replace(Worksheets("TITLE").Range("A" & rs).Value, "XXX-XXXXXX", amount)
Worksheets("REVISIONS").Range("D17").End(xlUp).Offset(1, 0) = newCell
End If
End Sub
I would take your code to an extra step.
No need to declare amount as String. You can keep it as a Variant. Also like I mentioned in the comment above
Can your Case number be like #D1-1%#456? If not then you have an additional problem to handle ;)
See this example. I have commented the code so that you will not have a problem understanding it. Still if you do lemme know :) The other way would be to use REGEX to validate your Case ID. Let me know if you want that example as well.
Code
Sub Sample()
Dim amount As Variant
' 123-$456789 <~~ Invalid
' 123-4567890 <~~ Valid
' ABC-&456789 <~~ Invalid
' 456-3456789 <~~ Valid
amount = Application.InputBox("Enter case number:", "")
'~~> Check if user pressed cancel
If amount = False Then Exit Sub
'~~> Check if then Case ID is valid
If IsValidCaseNo(amount) Then
MsgBox amount
Else
MsgBox "Invalid case ID"
End If
End Sub
Function IsValidCaseNo(sAmount) As Boolean
Dim s As String
Dim i As Long, j As Long
s = sAmount
'
'~~> Initial basic checks
'
'~~> Check if the length is 11 characters
If Len(Trim(s)) <> 11 Then GoTo Whoa
'~~> Check if the string contains "-"
If InStr(1, s, "-") = 0 Then GoTo Whoa
'~~> Check if the 4th character is a "-"
If Mid(s, 4, 1) <> "-" Then GoTo Whoa
'~~> Loop through 1st 3 characters and check
'~~> If they are numbers
For i = 1 To 3
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
Next
'~~> Loop through last 6 characters and check
'~~> If they are numbers
For i = 5 To 11
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case Else: GoTo Whoa
End Select
IsValidCaseNo = True
Next
Whoa:
End Function
If you Dim amount as String, you can test it as a string:
Sub GetDash()
Dim amount As String
amount = Application.InputBox(Prompt:="Enter case number", Type:=2)
If amount = "False" Then
MsgBox "You cancelled"
End If
End Sub
I am having trouble handling the error associated with a input box "Cancel" click. Or in otherwords, it returns an error within the sub if the value of the input is null. I have tried looking around and still can't seem to get it quite right. Here is my attempt:
Private Sub bttnSavingsExpected_Click()
Dim expected() As String
Dim nPeriods As Integer
Dim counter As Integer
Dim savings As Single
With ActiveSheet.Range("A13")
nPeriods = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
End With
ReDim expected(1 To nPeriods)
counter = 1
For counter = 1 To nPeriods
expected(counter) = Range("A13").Offset(counter, 0).Value
Next
TryAgain:
On Error GoTo ErrH
counter = 1
For counter = 1 To nPeriods
savings = InputBox("How much savings do you expect from " & expected(counter) & "?", "Savings?", Range("A13").Offset(counter, 1).Value)
If savings = "" Then
Exit Sub
Else
Range("A13").Offset(counter, 1).Value = savings
End If
Next
Exit Sub
ErrH:
MsgBox "Please enter value. If the default value is desired then please click 'OK'.", vbOKOnly, "Do Not Click Cancel"
GoTo TryAgain
End Sub
With this attempt, the MsgBox is displayed the first click whether there is a input or not and even if I click "Ok". The second try of clicking "OK" or "Cancel" leads to being kicked back to the editor.
You've got Dim savings As Single and If savings = "" Then. Thats always going to error
Try using Dim savings As Variant
Make sure the variable for the Inbox is set at "", then test the value for False. Much easier than anything else I have seen:
Sub WolfPackURL_input()
Dim TheURL As String
Dim SaveURL As Hyperlink
Set savedURL = Sheets("Data").Range("I1")
TheURL = ""
TheURL = Application.InputBox("Input the Sign-Up URL", "Wolfpack Weekly Players URL", "http://something", 1)
If TheURL = "False" Then
Exit Sub
End If
ThisWorkbook.Worksheets("Data").Activate
Sheets("Data").Range("I1").Hyperlinks.Delete
Sheets("Data").Range("I1").ClearContents
Sheets("Data").Range("I1").Clear
ActiveSheet.Hyperlinks.Add anchor:=Sheets("Data").Range("I1"), Address:=TheURL, ScreenTip:="Open file", TextToDisplay:=TheURL
End Sub