I am trying to assign a numeric value in VBA for a dropdown formfield. I have the Msgbox just to test functionality:
Sub ScreenB()
Dim a As Double
If ActiveDocument.FormFields("Dropdown9").DropDown.Value = No Then
a = 1
Else
a = 2
End If
MsgBox a
End Sub
With this code, my Msgbox does not change (it reads "2"), even when I change the the dropdown from Yes to No, or vice-versa. I also tried putting quotes around yes ("Yes") in the VBA code and got a Type Mismatch error.
You should use FormFields.Result
Sub ScreenB()
Dim a As Double
If ActiveDocument.FormFields("Dropdown9").Result = "No" Then
a = 1
Else
a = 2
End If
MsgBox a
End Sub
Related
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
I'm trying to link a user form I built in VBA editor for MS Excel 2010 to the data in an excel worksheet, but I'm getting a
run-time error 424: Object required.
I referred to the active worksheet explicitly in my code to try and remedy this, but it still comes up with the same error. My code is:
Private Sub GetData()
Dim r As Long
r = ActiveSheet.Range("B2").Value
If IsNumeric(RowNumber.Text) Then
r = CLng(RowNumber.Text)
Else
ClearData
MsgBox "Invalid row number"
Exit Sub
End If
If r > 1 And r <= LastRow Then
cboFilterResultId.Text = FormatNumber(Cells(r, 1), 0)
txtFolderPaths.Text = Cells(r, 2)
txtFileName.Text = Cells(r, 3)
txtDeletedDate.Text = Cells(r, 4)
txtReason.Text = Cells(r, 5)
txtcboAdd.Text = Cells(r, 6)
txtcboView.Text = Cells(r, 7)
txtcboChange.Text = Cells(r, 8)
DisableSave
ElseIf r = 1 Then
ClearData
Else
ClearData
MsgBox "Invalid row number"
End If
End Sub
Where RowNumber is a textbox where the user can enter the row number for the data they want.
Please help!
I rarely use ActiveSheet just in case that isn't the sheet I'm after. Generally better to be explicit which sheet you're referring to:
r=ThisWorkbook.WorkSheets("Sheet1").Range("B2")
Right, pulling data from a worksheet to a userform... as you haven't said which line your error occurs on and you haven't given us the code for ClearData or DisableSave I'll start from scratch.
Example Form Design
I create a blank userform and add three text boxes and a spin button to it:
txtRowNumber holds the row number that the data is pulled from.
TextBox1 and TextBox2 will hold my sample values.
In the Tag property of TextBox1 I enter 1 and in the Tag property of TextBox2 I enter 2. These are the column numbers that the data will be pulled from.
In reality I usually add extra stuff, for example, 8;CPER;REQD. I'd then use some code to pull it apart so it pastes in column 8, must have a percentage and is a required entry.
spnButton is used to quickly move up or down a row.
We'll need two procedures to populate the form from the given row number and to clear all controls on the form (ready for the next row to be brought in).
Any textbox or combobox that has something in it's Tag property is cleared:
Private Sub ClearForm()
Dim frmCtrl As Control
For Each frmCtrl In Me.Controls
If frmCtrl.Tag <> "" Then
Select Case TypeName(frmCtrl)
Case "TextBox", "ComboBox"
frmCtrl.Value = Null
Case Else
'Do nothing.
End Select
End If
Next frmCtrl
End Sub
Any control that has a Tag value (it's assumed the value is correct) is populated from the specified RowNumber and column (from the Tag value). The value is always taken from the sheet called MyDataSheet in the workbook containing the VBA code (ThisWorkbook) no matter which is currently active:
Private Sub PopulateForm(RowNumber As Long)
Dim frmCtrl As Control
For Each frmCtrl In Me.Controls
With frmCtrl
If .Tag <> "" Then
.Value = ThisWorkbook.Worksheets("MyDataSheet").Cells(RowNumber, CLng(.Tag))
End If
End With
Next frmCtrl
End Sub
Whenever txtRowNumber changes the form should update with values from the indicated row. To do this we'll need to clear the form of current data and then repopulate it:
Private Sub txtRowNumber_Change()
ClearForm
PopulateForm CLng(Me.txtRowNumber)
End Sub
The spin button should increase/decrease the value in .txtRowNumber. I've added checks that it doesn't go below 1. You should also add checks that it doesn't go higher than the last populated row.
Private Sub spnButton_SpinDown()
With Me
.txtRowNumber = CLng(.txtRowNumber) + 1
End With
End Sub
Private Sub spnButton_SpinUp()
With Me
If CLng(.txtRowNumber) > 1 Then
.txtRowNumber = CLng(.txtRowNumber) - 1
End If
End With
End Sub
Finally, the form should be populated when it is first opened:
Private Sub UserForm_Initialize()
With Me
.txtRowNumber = 2
.spnButton = .txtRowNumber
PopulateForm .txtRowNumber
End With
End Sub
I have code which looks like this:
Select Case IsNumeric(somevariable)
Case True
Resume Next
Case False
Call notnum
Else
Call MyErrorHandler
End Select
Is this overthinking it? Is there a chance IsNumeric will return something other than True or False here or is this bad programming practice?
Don't need the else as it will be true or false however, just a note the Else should be Case Else (moot point though as you are about to delete it)
Based on this though I wouldn't use a case for only 2 options:
If IsNumeric(somevariable) then
Resume Next
Else
Call MyErrorHandler
End if
Edit: Here is how error checking works:
Sub SheetError()
Dim MySheet As String
On Error GoTo ErrorCheck
MySheet = ActiveSheet.name
Sheets.Add
ActiveSheet.name = MySheet
MsgBox "I continued the code"
ActiveSheet.name = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
MsgBox "I will never get to here in the code"
End
ErrorCheck:
If Err.Description = "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic." Then
Resume Next
Else
MsgBox "Error I am not designed to deal with"
End If
End Sub
Copy and paste this module to your personal workbook or to a new workbook and run it, step through line by line using F8 to see how it is actually dealing with the error.
From OP's comment I'm not using my error handler. I want to do stuff with the hopefully numeric output
Sub demo()
Dim inputs As Variant
inputs = InputBox("Prompt", "Title", "Default")
If Not IsNumeric(inputs) Then
notnum
Else
' Do what you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Sub notnum()
' do not numeric stuff here
End Sub
Or if you want to keep prompting for numeric input until the users gets it right or cancels
Sub demo2()
Dim inputs As Variant
Do
inputs = InputBox("Enter something Numeric", "Title", "Default")
Loop Until IsNumeric(inputs) Or inputs = vbNullString
If Not inputs = vbNullString Then
' Do wht you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Input box can have different type of input validation. Try this
something = Application.InputBox("Pls Insert the Number", Type:=1)
If something = False Then Exit Sub
'Type:=0 A formula
'Type:=1 A number
'Type:=2 Text (a string)
'Type:=4 A logical value (True or False)
'Type:=8 A cell reference, as a Range object
'Type:=16 An error value, such as #N/A
'Type:=64 An array of values
I just discover problem with my code, which not appears yesterday.
This is code from "Sheet1 (Calculator)":
Option Explicit
Private Sub Worksheet_Activate()
Sheets("Calculator").ComboBox1.ListFillRange = "Materials!B4:B7"
Sheets("Calculator").ComboBox1.ListIndex = 0
End Sub
Private Sub ComboBox1_Change()
Sheets("Calculator").Range("T18") = ComboBox1.ListIndex + 1
Select Case Sheets("Calculator").ComboBox1.ListIndex
Case 0
Sheets("Calculator").ComboBox2.ListFillRange = "Materials!G4:G5"
Sheets("Calculator").ComboBox2.ListIndex = 0
Case 1
Sheets("Calculator").ComboBox2.ListFillRange = "Materials!G6"
Sheets("Calculator").ComboBox2.ListIndex = 0
Case 2
Sheets("Calculator").ComboBox2.ListFillRange = "Materials!G7:G10"
Sheets("Calculator").ComboBox2.ListIndex = 0
Case 3
Sheets("Calculator").ComboBox2.ListFillRange = "Materials!G11:G12"
Sheets("Calculator").ComboBox2.ListIndex = 0
End Select
End Sub
Everything working fine, while Excel is opened. But if I save and close Excel and then reopen it, code breaks at first line under "Case 0" with error message:
Run-time error '438'
Object doesn't support this property or method
Then when I stop debuging and change item in ComboBox1, code works fine again and ComboBox2 is filled with correct data. Do you have any ideas where can be problem?
Here is the file.
Dont know if you initialized your ComboBox object properly.....but this should work:
Set ComboBox1 = Sheets("Calculator").Shapes(1)
ComboBox1.ControlFormat.ListFillRange = "Materials!B4:B7"
so mayb its because mainly you are missing the ControlFormat thing!?
Private Sub ComboBox1_Change()
with Sheets("Calculator")
.Range("T18") = ComboBox1.ListIndex + 1
if .ComboBox1.ListIndex > -1 Then .ComboBox2.List=sheets("Materials").range(G4:G5").offset(choose(.ComboBox1.ListIndex+1).value
end with
End Sub
How can I check if the data from cmbTypeYacht.text already exists in cmbTypeYacht.list?
Here's what I've got:
Dim TypeYacht As String 'Type of yacht input
TypeYacht = cmbTypeYacht.Text
If TypeYacht = ("cmbTypeYacht list") Then
MsgBox "Type of Yacht is already on the list", vbExclamation, "Yacht Chantering"
Else
cmbTypeYacht.AddItem cmbTypeYacht.Text
With cmbTypeYacht
.Text = ""
.SetFocus
End With
End If
sorry about the tag im not quite sure which is it but im using Microsoft Visual Basic app.
The ComboBox class has a FindStringExact() method that will do the trick for you, like this:
Dim resultIndex As Integer = -1
resultIndex = cmbTypeYacht.FindStringExact(cmbTypeYacht.Text)
If resultIndex > -1 Then
' Found text, do something here
MessageBox.Show("Found It")
Else
' Did not find text, do something here
MessageBox.Show("Did Not Find It")
End If
You can also just loop through the list as well, like this:
Dim i As Integer = 0
For i = 0 To cmbTypeYacht.Items.Count - 1
If cmbTypeYacht.Items.Contains(cmbTypeYacht.Text) Then
MessageBox.Show("Found It")
Exit For
End If
Next
I'm working in Excel 2013 and there is no FindStringExact or .Items.Contains so, neither of those are valid. There is also no need to iterate the list. It is very simple actually. Given a userform "MyUserForm" and a combobox "MyComboBox",
If MyUserForm.MyComboBox.ListIndex >= 0 Then
MsgBox "Item is in the list"
Else
MsgBox "Item is NOT in the list"
End If
Explanation: If selected item is not in the list, .ListIndex returns -1.
The combobox in vba has a property called MatchFound. It will return true if the value you inputted in the combobox (ComboBox.Value) existed before.
Put below code in the update event of the combobox for trial
Private Sub ComboBox_AfterUpdate()
If ComboBox.MatchFound = True then
Msgbox "Value exist"
End If
End Sub
Check it out:
https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/combobox-matchfound-property-outlook-forms-script
You do not need to iterate through combobox.items. Items.Contains will already iterate through the list for you.
Simply use:
If cmbTypeYacht.Items.Contains(cmbTypeYacht.Text) Then
MessageBox.Show("Found It")
Exit For
End If
Searching: VBA check whether the data already exists in combobox list?
but vba doesnt have the properties above.
Sub TestString()
Dim myString As String
Dim i As Long
Dim strFound As Boolean
'Just for test purposes
myString = "Apple"
strFound = False
With Me.ComboBox1
'Loop through combobox
For i = 0 To .ListCount - 1
If .List(i) = myString Then
strFound = True
Exit For
End If
Next i
'Check if we should add item
If Not strFound Then .AddItem (myString)
End With
End Sub
This was found after a lot of searching at http://www.ozgrid.com/forum/showthread.php?t=187763
and actually works