Using excel vba to change the value of a dropdown menu on a website - excel

I am writing an Excel macro to fill out a form on a website. I have written the code that populate the text boxes easily enough, and found code to chose radio boxes, but I am having problems with choosing info from dropdown menus.
Example 'Gender':
The combo box has three options:
Select / Male / Female
I've tried a few variations on this:
doc.getElementsByName("xs_r_gender").Item(0).Value="Male"
...but with no luck.
This is the web source code:
<td> <select name="xs_r_gender" id="xs_r_gender">
<option value="" selected>Select</option>
<option value="male">Male</option>
<option value="female">Female</option> </select></td>
Thanks.

doc.getElementById("xs_r_gender").selectedindex=1
seems to do the trick. (Where 1 represents male)
Though it means I will need to do alot of lookups to determine what the value is for the items in my dropdown. (Easy enough for Sex, where there are only two options, but I have some comboboxes with up to 50 options). If anyone knows of a faster solution, that'd be great. In the meantime, Ill start doing up some tables!!!
thanks.

Try below code assuming doc = ie.document
doc.getElementById("xs_r_gender").value = "Male"

Use this in your code to call the function below.
xOffset = SetSelect(IE.Document.all.Item("shipToStateValue"), "Texas")
doc.getElementById("shipToStateValue").selectedindex = xOffset
Then use this for your function
Function SetSelect(xComboName, xComboValue) As Integer
'Finds an option in a combobox and selects it.
Dim x As Integer
For x = 0 To xComboName.options.Length - 1
If xComboName.options(x).Text = xComboValue Then
xComboName.selectedindex = x
Exit For
End If
Next x
SetSelect = x
End Function

Thanks Stack, works for me! My solution to operate an IE HTML combobox drop down turned out to be two parts.
Part 1 was to click the pull down, here's code:
Dim eUOM1 As MSHTML.HTMLHtmlElement
Set eUOM1 = ie.document.getElementsByTagName("input")(27).NextSibling
eUOM1.Focus
eUOM1.Click
Part 2 was to choose and click the value, like this (*actual element name changed):
Dim eUOM2 As MSHTML.HTMLHtmlElement
Set eUOM2 = ie.document.getElementsByName("[*PutNameHere]")(0)
eUOM2.Value = "EA"
eUOM2.Click
Here are references:refs

You can try the querySelector method of document to apply a CSS selector of option tag with attribute value = 'male':
doc.querySelector("option[value='male']").Click
or
doc.querySelector("option[value='male']").Selected = True

Function SetSelect(s, val) As Boolean
'Selects an item (val) from a combobox (s)
'Usage:
'If Not SetSelect(IE.Document.all.Item("tspan"), "Custom") Then
'something went wrong
'Else
'continue...
'End If
Dim x As Integer
Dim r As Boolean
r = False
For x = 0 To s.Options.Length - 1
If s.Options(x).Text = val Then
s.selectedIndex = x
r = True
Exit For
End If
Next x
SetSelect = r
End Function

Try this code :
doc.getElementById("xs_r_gender").value = "Male"
doc.getElementById("xs_r_gender").FireEvent("onchange")

You can do something like this:
doc.getElementsByName("xs_r_gender").Item(1).Selected=True
or
doc.getElementById("xs_r_gender").selectedindex = 1
Where 1 is the male option (in both cases).
If the dropbox needs to fire some event in order to aknowledge your choice, it is likely that it will be the "onchange" event. You can fire it like so:
doc.getElementById("xs_r_gender").FireEvent("onchange")
If you ever want to be able to select an option based on the option's text you can use the function given by Lansman (here) .
Based on the same answer, if you want to call the option by it's value property (instead of the text, you can just change the line If xComboName.Options(x).Text = xComboValue Then to If xComboName.Options(x).value = xComboValue Then).
This should cover all bases.

Copy from Here till last line:
Sub Filldata()
Set objShell = CreateObject("Shell.Application")
IE_count = objShell.Windows.Count
For X = 0 To (IE_count - 1)
On Error Resume Next ' sometimes more web pages are counted than are open
my_url = objShell.Windows(X).document.Location
my_title = objShell.Windows(X).document.Title
If my_title Like "***Write your page name***" Then
Set IE = objShell.Windows(X)
Exit For
Else
End If
Next
With IE.document.forms("***write your form name***")
' Assuming you r picking values from MS Excel Sheet1 cell A2
i=sheet1.range("A2").value
.all("xs_r_gender").Item(i).Selected = True
End with
End sub

Related

Clear ComboBox Containig an Array VBA and Repopulate with Column Index

I have a sigle column ComboBox that I have populated with a dynamic array; however, I'd like the code to replace the value of the combo box with respective column from my ListBox.
'Prepares the Active Escorts list box.
ivb = 0
i = 0
With frmEntry
.listboxActiveEscorts.Clear
.listboxActiveEscorts.ColumnHeads = False
.listboxActiveEscorts.ColumnCount = "15"
.listboxActiveEscorts.ColumnWidths = "0,100,100,0,0,100,100,0,0,0,0,0,100,100,80"
i = 0
'Badge # combobox properties
ReDim vbArray(0 To vbArrayCount - 1)
For i = 0 To vbArrayCount - 1
ivb = ivb + 1
vbArray(ivb - 1) = loVisBadge.Range.Cells(i + 2, 1).Value
Next i
.cbxVisitorBadgeNumber.List = vbArray
End With
This population of the ComboBox executes beautifully, in my belief, but if you see a better way to implement the dynamic list, I'm all ears.
I have a button that I will use to reset the form, which also works for the most part. When an item is selected from the list, I am able to clear all controls except for the ComboxBox containing the array of values. I will be adding two additional arrays to each of the other ComboBoxes on the form, and I imagine I am going to have the same problem: "Could not set the value property. Invalid property value"
This is the code assigned to click event of the ListBox:
Private Sub listboxActiveEscorts_Click()
With frmEntry
.cbxEscortSelectName.Value = .listboxActiveEscorts.Column(1) + " " + .listboxActiveEscorts.Column(2)
.txtCredential.Value = .listboxActiveEscorts.Column(4)
.txtEscortCompany.Value = .listboxActiveEscorts.Column(3)
.cbxVisitorName.Value = .listboxActiveEscorts.Column(5) + " " + .listboxActiveEscorts.Column(6)
.txtVECompany.Value = .listboxActiveEscorts.Column(7)
.txtVEDOB.Value = .listboxActiveEscorts.Column(8)
.txtVEIdentification.Value = .listboxActiveEscorts.Column(9)
.txtVEIDNumber.Value = .listboxActiveEscorts.Column(10)
.txtVEExpirationDate.Value = .listboxActiveEscorts.Column(11)
.txtVEStart.Value = .listboxActiveEscorts.Column(12)
.txtVEEnd.Value = .listboxActiveEscorts.Column(13)
'.cbxVisitorBadgeNumber.Value = ""
.cbxVisitorBadgeNumber = vbNullString
.cbxVisitorBadgeNumber.Value = .listboxActiveEscorts.Column(14)
End With
End Sub
What am I missing here. I tried to ReDim the array that assigned the values, but that didn't work. Is it a data type thing, perhaps?
In the picture below, you'll see the values populated in the controls, all except the visitor badge # (ComboBox which throws the error...I have commented out the line for illustration purposes, so you'll see the visitor badge # is blank).

Problem with multiline string in userform

I am having a issue with multiline stings in a userform.
When a user selects a option, the code checks if the selected answer matches the correct answer and then shows if right or wrong. But in either case the code says it is wrong.
Example of a option is:
If you see the string, brush it off sideways
Place icepack/cold flannel to reduce swelling
Elevate area to reduce bloodflow
Private Sub OptionButton1_Click()
rowNum = Selection.Row - Selection.ListObject.Range.Row
DeclareVars
Column = examtable.ListColumns("Right ans").DataBodyRange(rowNum)
CorrectAns = examtable.ListColumns("Right ans").DataBodyRange(rowNum).Offset(0, Column)
RightWrong.Visible = True
If OptionButton1.Caption = CorrectAns Then
RightWrong.BackColor = &HFF00&
RightWrong.Caption = "Right"
Else
RightWrong.BackColor = &HFF&
RightWrong.Caption = "Wrong"
End If
End Sub
What i am expecting is that if correct, shows right, or wrong if incorrect
If I understand correctly you have multiple option buttons below one another? Option button one will always have the same caption. If it is selected it can become true (indicated by the black dot), but the caption will not change.
Lets say it looks like this
two option buttons
Then the upper is called OptionButton1, the lower OptionButton2.
You can check
If OptionButton1 then
RightWrong.BackColor = &HFF00&
RightWrong.Caption = "Right"
Else
RightWrong.BackColor = &HFF&
RightWrong.Caption = "Wrong"
End if
You could use a combobox (these are the drop down menus).
You could populate it with an array of the strings you want to test and ask if the answers concur.
When loading the user form use
Private Sub UserForm_Activate()
ComboBox1.list = Array("brush it off sideways", "Place icepack/cold flannel to reduce swelling", "Elevate area to reduce bloodflow")
End Sub
this will look as followed
The user form with the list open
Then you can say combobox.value = CorrectAns

How to loop through XML-nodes and validate if values exists?

I have through an API fetched my data as an XML, and I wish to cycle through nodes (there are several of the same type) and add them to certain fields/a table.
Example from the XML-file:
<HistRating
xmlns="">
<EndrAr>2020</EndrAr>
<EndrMnd>7</EndrMnd>
<Rating>A</Rating>
</HistRating>
<HistRating
xmlns="">
<EndrAr>2019</EndrAr>
<EndrMnd>6</EndrMnd>
<Rating>A</Rating>
</HistRating>
I have tried the following format (at this point the XML I need is in a string in xmlDoc xmlDoc = CreateObject("MSXML2.DOMDocument.6.0"). Fully aware that this is not a really "sexy" way to write it, but I'm new at this game:
Set nodeXML = xmlDoc.getElementsByTagName("EndrAr")
Range("G1").Value = nodeXML(1).Text
Range("H1").Value = nodeXML(2).Text
Range("I1").Value = nodeXML(3).Text
Set nodeXML = xmlDoc.getElementsByTagName("EndrMnd")
Range("G2").Value = nodeXML(1).Text
Range("H2").Value = nodeXML(2).Text
Range("I2").Value = nodeXML(3).Text
Set nodeXML = xmlDoc.getElementsByTagName("Rating")
Range("G3").Value = nodeXML(1).Text
Range("H3").Value = nodeXML(2).Text
Range("I3").Value = nodeXML(3).Text
This works great as long as all three items are there. Unfortunately that is not given. If it is a new company i.e. (3) wont exist (there is one line per year above), and I would like to either set the cell to Blank or No value or something.
The result from when I run the above code:
But if I try to add a line 4 to test what happens if value does not exists I get the following (for obvious reasons)
What I would love some help with is:
Can I by some "magic" add a ifmissing (tried it, but could not get it to work)?
Other ways to add a if variable is not found, input following into cell
Or are there a complete different way I should have solved this?
This is to add accounting data from last X available years (where X is ie 4, or less if not 4 is available) from 30 nodes.
You could use an Error trapping Function. Note in the code below we choose not to use the returned boolean.
Dim myTest as String
.
.
TryReadingXmlNode nodeXML,1, myText
Range("G1").Value = myText
.
.
Public Function TryReadingXmlNode(ByVal ipNode as object, ByVal ipIndex as Long, ByRef opText as string) as boolean
On Error Resume Next
opText=ipNode.Item(ipIndex).Text
TryReadingXmlNode=Len(opText)>0
If err.number>0 then opText="NoValue"
on Error Goto 0
End Function
Start by querying all of the HistRating elements, then loop over that collection:
Const MAX_YEARS As Long = 4
Dim ratings, rating, c As Range, i as Long
Set c= Range("A1")
Set ratings = xmlDoc.getElementsByTagName("HistRating")
For Each rating in ratings
c.offset(0, i) = rating.getElementsByTagName("EndrAr")(0).Text
c.offset(1, i) = rating.getElementsByTagName("EndrMnd")(0).Text
c.offset(2, i) = rating.getElementsByTagName("Rating")(0).Text
i = i + 1
If i >= MAX_YEARS Then Exit For 'exit if processed enough nodes
Next rating

VBA Checkbox uncheck event and multiple range load to listbox

I am working on a small project and have difficulties with the following code. got help here with the second part of the code before (intentionally included the code for load only for the first three items (adig, altay, ataysk) to check the code:
Dim adig(), altay(), altaykr(), amur(), arh(), astr(), bashk(), belgor(), bryansk(), buryat(), vladim(), volgo(), vologod(), fulllist() As Variant
adig = ActiveWorkbook.Worksheets("Cities").Range("adig").Value
altay = ActiveWorkbook.Worksheets("Cities").Range("altay").Value
altaykr = ActiveWorkbook.Worksheets("Cities").Range("altaykr").Value
fulllist =ActiveWorkbook.Worksheets("Cities").Range("fulllist").Value
If (Not ListofExcludelocations.Selected(0)) And Excludelocations.Value =True Then
For Each i In adig
NegKeyList.AddItem i
Next i
End If
If (Not ListofExcludelocations.Selected(1)) And Excludelocations.Value =true Then
For Each i In altay
NegKeyList.AddItem i
Next i
End If
If (Not ListofExcludelocations.Selected(3)) And Excludelocations.Value = True Then
For Each i In altaykr
NegKeyList.AddItem i
Next i
End If
For i = NegKeyList.ListCount - 1 To 0 Step -1
If Not IsError(Application.Match(NegKeyList.List(i), fulllist, 0)) Then
NegKeyList.RemoveItem i
End If
Next i
TextBox2.Value = NegKeyList.ListCount & " neg.keys"
Next j
End sub
the code loads items from each of the named ranges in array to the listbox1 when the checkbox is checked. This part works fine. I have difficulties with the following:
1. The second part of the code does not actually remove the items from the checkbox when it is unchecked. Could someone check what is wrong as I cannot understand it?
2. Each range (arh, astr, etc) contains different number of items. I need to make sure that if the listbox item is not selected the values from each range are loaded to listbox. The way it works now, obviously, is that I have to make separate If statement for each item. It makes the trick for little number of items, but I would like this code to be applicable for array, which has 70+ ranges in it. Can someone help me to change it in order not to need to make If statement for each item in array like it is now and rather work with For each...statement?
Found the solution by copying the values to hidden listbox.
For counter1 = NegKeyList.ListCount - 1 To 0 Step -1
For counter2 = 0 To Bcities.ListCount - 1
'InStr returns 0 when there's no match
If (CStr(NegKeyList.List(counter1))) = (CStr(Bcities.List(counter2))) Then
NegKeyList.RemoveItem (counter1)
Exit For 'Skip any more compares for the deleted Item
End If
Next counter2
Next counter1

LibreOffice Basic Ignoring “some” of my Type...End Type Definition

I'm using LibreOffice Version: 4.4.3.2 Build ID: 40m0(Build:2) Locale: en_AU
I have a Basic Module
At the top of this module before any sub or functions I have
Type InitHeadings
MySort_By As Integer
MyCharacter As Integer
MyInitiative As Integer
MyRolled As Integer
MyTotal As Integer
End Type
...
Global InitiativeColumn As New InitHeadings
But when I run a sub, set a breakpoint and 'watch' the InitiativeColumn Object only the first two fields are shown.
The rest of my code relevant to this struct as the documentation calls them is below. I don't reference it anywhere else. Can anyone tell me why the first two would work but not the rest? I have two other structs in this code and both also ignore the last three fields. Is this a Bug?
Sub Main
'Initialise Doc and Sheet Objects
Dim Doc As Object
Doc = ThisComponent
StatsSheet = Doc.Sheets.getByName("Stats")
InitiativeSheet = Doc.Sheets.getByName("Initiative")
CombatSheet = Doc.Sheets.getByName("Combat")
'LOAD HEADING NAMES
'Initiative Sheet
For Column = 0 to 25 'Columns A to Z
MyHeadingName = InitiativeSheet.getCellByPosition(Column,0).String
Select Case MyHeadingName
Case "Sort By"
InitiativeColumn.MySort_By = Column
Case "Character"
InitiativeColumn.MyCharacter = Column
Case "Initiative"
InitiativeColumn.MyInitiative = Column
Case "Rolled"
InitiativeColumn.MyRolled = Column
Case "Total"
InitiativeColumn.MyTotal = Column
End Select
Next Column
End Sub
Sub MyInitiativeButton
'Iterate over a range of cells:
For Row = 1 To 25 'Rows 2 to 26
'Column 3 is column D the "Rolled" column
InitiativeSheet.getCellByPosition(InitiativeColumn.MyRolled,Row).VALUE = Roledice(1,20,0)
Next Row
End Sub
It looks like a bug, and seems to have been reported here. The problem did not occur when I tested it in a newer version (LO 5.1.0.3).
This is only an issue for the debugger window. The values are still there:
Sub TestStructs
InitiativeColumn.MySort_By = 5
InitiativeColumn.MyCharacter = 5
InitiativeColumn.MyTotal = 5
InitiativeColumn.DoesntExist = 5
End Sub
This code works fine until the line InitiativeColumn.DoesntExist = 5, whereupon it crashes.
Now the Global problem that you mentioned in the comments is really a problem. Considering the standard programming advice that global variables are bad, I think it's wise to consider alternatives.
Instead of a subroutine, could you perhaps use a Function that returns InitiativeColumn? If not, then assigning the variable as you suggested seems a viable workaround. Personally for LO macros I prefer Python or Java since they have classes.

Resources