Compare part of Combobox1.value with combobox2 - excel

I have created a userform with comboboxes, I would like to compare the a part of combobox 2 with the value of combobox 1. if they do not match there should be an error given (as in my code, see below), the code that I made is not working, but I do not know what is wrong.
the error that is showing is:
Compile error: Sub or Function not defined #Find
If Left(Me.ComboBox2.Value(Find(" -", Me.ComboBox2.Value, 1) - 1)) <> Me.ComboBox1 Then
MsgBox "The tag of " & m2.ComboBox2.Tag & "does not match with selected BIN"
Exit Sub
End If

It is working already with the following code, thanks anyway for the help.
If Left(Me.ComboBox2.Value, InStr(Me.ComboBox2.Value, " -") - 1) <> Me.ComboBox1 Then
MsgBox "The tag of " & me.ComboBox2.Tag & "does not match with selected BIN"
Exit Sub
End If

Related

Update cell with a value when form field is selected

I have an excel workbook with modeless form. The way it's setup is that: each sheet in the workbook has a tab in the form. Each field in these tabs is Linked to a cell in corresponding sheet. So when a value is changed/updated in the form, it is automatically updated in the relevant cell. The way I am doing this is by using the onChange event for each filed which call's a UDF that does the updating. My question, there are a lot of fields in the form and lots more to be added. Is there a way to update relevant cell when a field in the form is selected without having to add the call to a UDF in onChange event for each field?
I have tried using things like ControlSource but that only one way where it just updates the value in the form but doesn't update the value in the cell when form is updated.
As a side note, unfortunately I cannot share the form or the sheet but am willing to answer any questions
EDIT
Below is the function that updates the field:
Sub UpdateWorksheetValue(ByVal oObj As Object)
Dim oWS As Worksheet
Dim sCurrentValue As String
Dim iC As Long
' Lets check if tag is set
If Len(Trim(oObj.Tag)) = 0 Then
MsgBox "Empty tag found for '" & oObj.Name & "' field. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
Exit Sub
ElseIf Len(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1))) = 0 Then
MsgBox "Tag for '" & oObj.Name & "' field does not include page title. Failed to update field value" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
Exit Sub
End If
' Set worksheet
Select Case LCase(Trim(Mid(oObj.Tag, InStr(1, oObj.Tag, "¬") + 1)))
Case "client identification"
Set oWS = oWB.Worksheets("Client Identification - Output")
Case "request details"
Set oWS = oWB.Worksheets("Request Details - Output")
Case "db responsible individuals"
Set oWS = oWB.Worksheets("DB Responsible Ind - Output")
Case "additional details"
Set oWS = oWB.Worksheets("Additional Details - Output")
End Select
' Set value
With oWS
' Lets check if tag is set
If Len(Trim(Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1))) = 0 Then
MsgBox "Tag for '" & oObj.Name & "' field does not include corresponding cell information. Failed to update field value in '" & oWS.Name & "' worksheet" & vbCrLf & vbCrLf & "Please contact system administrator with this information", vbCritical + vbOKOnly, "Update Failed"
Exit Sub
End If
' Set the search value
.Range("Z1").Value = Mid(oObj.Tag, 1, InStr(1, oObj.Tag, "¬") - 1)
DoEvents
' If a row with tag text is not found, throw a message and exit sub
If Len(Trim(.Range("Z2").Value)) = 0 Then
MsgBox "Unable to find corresponding cell for '" & oObj.Name & "' field in '" & .Name & "' worksheet. Failed to update field value" & vbCrLf & vbCrLf & "Please ensure that the field's 'Tag' matches a cell in the sheet or contact system administrator", vbCritical + vbOKOnly, "Update Failed"
Exit Sub
End If
' Set field value
Select Case LCase(TypeName(oObj))
Case "textbox", "combobox"
.Range("B" & .Range("Z2").Value).Value = oObj.Value
Case "optionbutton"
If oObj.Value = True Then
.Range("B" & .Range("Z2").Value).Value = oObj.Caption
Else
.Range("B" & .Range("Z2").Value).Value = ""
End If
Case "listbox"
' First lets the current cell value
sCurrentValue = .Range("B" & .Range("Z2").Value).Value
' Now lets build the string for the cell
For iC = 0 To oObj.ListCount - 1
If oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) = 0 Then
sCurrentValue = sCurrentValue & "/" & oObj.List(iC)
ElseIf Not oObj.Selected(iC) And InStr(1, sCurrentValue, oObj.List(iC)) > 0 Then
sCurrentValue = Replace(sCurrentValue, "/" & oObj.List(iC), "")
End If
Next
' And finally, set the value
.Range("B" & .Range("Z2").Value).Value = sCurrentValue
End Select
End With
' Clear object
Set oWS = Nothing
End Sub
EDIT 2
I now have a class called formEventClass as suggested by David. Contents of the class are:
Option Explicit
Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
UpdateWorksheetValue (tb)
End Sub
But when I make a change in any given text box, cells are not updated (as per David's suggestion, I've removed the call to UpdateWorksheetValue in text box onChange event. Cells are not updated even when I tab out of the field. As this is working for David, I suspect I am missing something here
If you want to get fancy using WithEvents...
Create a Class Module and name it tbEventClass. Put the following code in this module.
Option Explicit
Public WithEvents tb As MSForms.TextBox
Private Sub tb_Change()
Call UpdateWorksheetValue(tb)
End Sub
This defines a custom class (tbEventClass) which is responsive to the events of it's tb property which is a TextBox. You'll need to map your textboxes to instances of this class during the form's Initialize event:
Public textbox_handler As New Collection
Private Sub UserForm_Initialize()
Dim ctrl As Control, tbEvent As tbEventClass
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
Set tbEvent = New tbEventClass
Set tbEvent.tb = ctrl
textbox_handler.Add tb
End If
Next
End Sub
Important: You will either need to remove or modify the Change event handlers in the UserForm module to avoid duplicate calls to the "update" procedure. If the only thing going on in those event handlers is the call to your update macro, just get remove the event handlers entirely, they're fully represented by the tbClass. If those events contain other code that does other stuff, just remove or comment out the line(s) that call on your update function.
Update:
This is working for me with the controls within a MultiPage and required ZERO changes to the implemented code above.

error message not appearing though there is no error and put exit sub before error hadeler statment in vba

I have been figuring out how to pop up msg box if there is error. I have below code but this code does not jump to error handler if there is error and Exit the sub.
Sub Validate_Region()
Dim str_DEPARTMENT_NAME As String
On Error GoTo Reion_Error
If Left(Range("M4"), 2) = "As" Then
str_DEPARTMENT_NAME = "India"
ElseIf Left(Range("M4"), 2) = "ME" Then
str_DEPARTMENT_NAME = "Middle East"
End If
'Get value of region selected in Master File
str_regionvalue = Workbooks("Master Report").Sheets("Home").Range("T8")
If str_regionvalue = str_DEPARTMENT_NAME Then
MsgBox ("You have selected " & str_regionvalue & " region"), vbInformation
End If
Exit Sub
Reion_Error:
MsgBox ("Please select the correct Region.") & vbNewLine & vbNewLine & ("You have selected " & str_regionvalue & " region" & " In Home Sheet of Master Report and pulled the data for " & str_DEPARTMENT_NAME & " region"), vbCritical
ActiveWorkbook.Close
End Sub
I just copy/pasted your code and it works well for me:
I don't know from where this sub is called and what type of variable is used on str_regionvalue (seems like Variant)
So what can you do with this:
Get rid of Exit Sub on line #19.
Put Err.Number check in your error handler:
Reion_Error:
If Err.Number <> 0 Then
MsgBox ("Please select the correct Region.") & vbNewLine & vbNewLine & ("You have selected " & str_regionvalue & " region" & " In Home Sheet of Master Report and pulled the data for " & str_DEPARTMENT_NAME & " region"), vbCritical
'by the way, you can try to set ActiveWorkbook.Saved to True, to get rid from pop-ups on Close
ActiveWorkbook.Close
End If
Try to look for error number thru debugging (debug.print err.number or place some stop's to do this manually). Or add err.number to Watches and check Break when value changes so you can track where error raised and cleared (if raised).
Err object
P.S. You got some ridiculous MsgBoxes, if you really like parentheses, use them like this:
Call MsgBox("Please select the correct Region." & vbNewLine & vbNewLine & _
"You have selected " & str_regionvalue & " region" & " In Home Sheet of Master Report and pulled the data for " & str_DEPARTMENT_NAME & " region", vbCritical)
Under Tools >> Options in the VB Editor: on the General tab make sure you don't have "Error trapping" set to "Break on all errors"
Check your syntax, you have quite a few unnecessary brackets and commas in your msgbox statements. Try something like:
returnval = MsgBox ("Put message here" , vbInformation)
OR
MsgBox "another message " & vbnewline & "some more message", vbcritical
The code looks fine and compiles now but I think your error may be elsewhere. Possibly in:
str_regionvalue = Workbooks("Master report").Sheets("Home").Range("T8")
I'd suggest:
Leave the 'exit sub' in. It's correct.
Add 'Option Explicit' to the top of the code - it will force you to declare all variables (str_regionvalue isn't declared)
Set your Under Tools >> Options in the VB Editor: to 'Break on Unhandled Errors'.
Put in a breakpoint (Debug >> Add Watch) at the top of the code and run through it step by step using Debug >> Step Into.

Vba want user to force fill form when not filled programme should not continue futher

I have a form that a user should fill and if certain fields are not filled the form should not continue further but it still does may be I am not see some thing help please
this is under the button presed If Me.cbTyreNsf.value = " " Then
MsgBox "You must complete the Wheel Nsf value", vbCritical
Exit Sub
End If
If Me.cbTyreNsR.value = "" Then
MsgBox "You must complete Wheel Nsr value", vbCritical
Exit Sub
End If
the function called
Call CheckifRecordExistOnWheelTable
the code for the function
Select Case avar
Case "NULL"
Call insertWheel
Case Else
Call updateWheel
End Select
and the code for the function called by the function
nssf = Me.cbTyreNsf.value
Select Case nssf
Case "0"
MsgBox " Please enter the NSF tyre value", vbCritical
Me.cbTyreNsf.SetFocus
' MsgBox "about to exit"
Exit Sub
Case Else
nsf = CInt(nssf)
End Select
any help please i have been on it for 24 hours counting tried every thing
This can be a problem:
nssf = Me.cbTyreNsf.value
it does not pass any value to nssf if there is no value in the cbTyreNsf. (try msgbox(nssf) at that point. It will give you blank message box). If you want to test it using your current select case then you can try checking length of the value which will be 0 for empty cbTyreNsf.
nssf =Len(Me.cbTyreNsR.value)

Excel Inputbox displaying 0 instead of empty string

I am working on an excel vba project and have run into an odd issue. I am working inside of a button click sub and want to display the current note as the default while they update the note. Unfortunately, all empty cells show up with a default value of "0". The msgbox just before is for debugging purposes and it shows "" (nothing). Any ideas?
MsgBox Sheet4.Range("E" & stallToAdd + 1)
inputFromUser = Application.InputBox("Update note: ", "Update Note", Sheet4.Range("E" & stallToAdd + 1))
Edit: inputFromUser is a variant, stallToAdd is an integer.
Just convert it to a string like this:
inputFromUser = Application.InputBox("Update note: ", "Update Note", _
CStr(Sheet4.Range("E" & stallToAdd + 1)))

EXCEL VBA WorksheetFunction.CountIf() in a SELECT CASE

I know that it is possible to use If statement but out of curiosity, as mentioned in the title, is it possible to use SELECT statement to do something as BOLDED below? I've submitted my whole Sub as below for better understanding:
Sub addNewCust_Click()
Dim response As String
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False
Exit Sub
'Check if response is not an empty value AND record found in "CustomerList"
Case Is <> "" & WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) > 0
MsgBox "'" & response & "' already exists on this sheet."
Call addNewCust_Click
'Check if response is not an empty value and record is not found in "Customerlist"
Case Is <> "" & WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) < 1
Sheets("CustomerList").Range("B1048576").End(xlUp).Offset(1, 0).Value = response
MsgBox "'" & response & "' successfully entered!"**
Case Else
MsgBox "Field is empty!"
Call addNewCust_Click
End Select
End Sub
Like this?
Sub addNewCust_Click()
Dim response As String
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False: Exit Sub
'Check if response is not an empty value AND record found in "CustomerList"
Case Is <> ""
If WorksheetFunction.CountIf(Worksheets("CustomerList").Range("B:B"), response) > 0 Then
MsgBox "'" & response & "' already exists on this sheet."
Call addNewCust_Click
Else
Sheets("CustomerList").Range("B1048576").End(xlUp).Offset(1, 0).Value = response
MsgBox "'" & response & "' successfully entered!"
End If
Case Else
MsgBox "Field is empty!"
Call addNewCust_Click
End Select
End Sub
FOLLOWUP (From Comments)
Select Case is considered to be faster than If-Endif but for such a small scenario, the efficiency comparison is futile. What is more important is how you write the code
Below is another way. I love this way as things are broken down into smaller parts and everything is declared properly. I am not touching error handling below. See this for detailed analysis.
The below method is useful because
when you are looking at your code (say maybe after an year) and you know exactly what is happening since the code is commented.
Easy to maintain the code. For example if the Sheet name changes then you have to change it only at one place. The alternative is to also use Codenames
You can use the same code across all Excel platforms. If you hardcode your range, Ex: Range("B1048576") then the above code will not work in Excel 2003.
Sample Code
Sub addNewCust_Click()
Dim ws As Worksheet
Dim Lrow As Long
Dim response
'~~> Set the relevant worksheet
Set ws = ThisWorkbook.Worksheets("CustomerList")
With ws
Do
'~~> Get user response
response = Application.InputBox(prompt:="", Title:="New customer name", Type:=2)
Select Case response
Case False: Exit Sub '<~~ If user presses cancel or closes using 'X'
Case "": MsgBox "Field is empty!" '<~~ If user enters a blank entry
Case Else
'~~> Check if the entry exists
If WorksheetFunction.CountIf(.Range("B:B"), response) > 0 Then
MsgBox "'" & response & "' already exists on this sheet."
Else
'~~> Get last Row
Lrow = .Range("B" & .Rows.Count).End(xlUp).Row + 1
'~~> Add the new entry
.Range("B" & Lrow).Value = response
MsgBox "'" & response & "' successfully entered!"
Exit Do 'OR Exit Sub (As Applicable)
End If
End Select
Loop
End With
End Sub

Resources