I'm trying to count all elements in a listbox on a webpage (eventually loop through them, but solving this issue will help with looping):
Im quite new to VBA, but i do believe this is a listbox object, as in firebug name of this object has "listbox" at the end.
All the suggestions i found here or elsewhere related to either .ListCount or .ListIndex
Somehow, either of these result in error 438, object not supported.
Piece of code below.
Can you suggest please?
With IE.document
.getElementById("xxx_startDay").Value = "1"
.getElementById("xxx_startMonth").Value = "JAN"
.getElementById("xxx_startYear").Value = "2017"
.getElementById("xxx_endDay").Value = "31"
.getElementById("xxx_endMonth").Value = "JAN"
.getElementById("xxx_endYear").Value = "2017"
'IE.document.getElementById("xxx_accountItemsListBox").Focus
Set listMPAN = IE.document.getElementById("xxx_accountItemsListBox")
listMPAN.selectedIndex = 5
MsgBox (listMPAN.ListCount)
End With
Help was closer than i thought.
Turned out the ListBox was not the real listbox, it was some other html element with listbox generated on the server side (just trying to repeat what i was told):
<select size="4" name="xyz" multiple="multiple" id="xxx_accountItemsListBox" class="accountItemsListBox">
so the .ListCount wasnt recognised. Instead i had to use .Length and
msgbox(listMPAN.Length)
worked perfectly. Now looping through it should be simple.
Thank you.
This was my alternative answer:
On Error GoTo endCount
For i = 0 To 100
Debug.Print myDoc2.getElementById("quoteDropdown").Item(i).Value
Next i
endCount:
On Error GoTo 0
If i <> 0 Then
Debug.Print "there are " & i & " options."
End If
Related
I have the follow code that is running in an Excel and it's calling a PowerPoint slide. I am setting a text to each existing node of the SmartArt and it's working. However, I am getting error when I use AddNode method (oSmartArt.AllNodes.Add.AddNode). What am I doing wrong?
Set oSmartArt = d_ppt_output.Slides(SLIDE_SMART).Shapes("MyList").SmartArt
x = 1
While Cells(x, 1).Text <> ""
If x > oSmartArt.Nodes.Count Then
oSmartArt.AllNodes.Add.AddNode ''''' ERROR IS HERE!
End If
oSmartArt.AllNodes(x).Shapes.TextFrame2.TextRange.Text = ActiveSheet.Cells(x, 2).Text
x = x + 1
Wend
I also replaced oSmartArt.AllNodes.Add.AddNode by oSmartArt.Nodes.Add.AddNode but I get the same problem.
The error is:
-2147467259 (80004005)
Method 'add' of object 'SmartArtNodes' failed
The whole code can by found here - https://drive.google.com/drive/folders/1_O79iiG7hbBjMHMSH6kZGkWmjN1WGorR?usp=sharing
As posted, your code doesn't run. You can't reference a slide with a name that's not in quotes. I created a super-simple version in PowerPoint that starts with a 5-member SmartArt. This is running without an error. It adds a new node and fills in the text as expected:
Sub Test()
Set oSmartArt = ActivePresentation.Slides(1).Shapes(2).SmartArt
oSmartArt.AllNodes.Add.AddNode
oSmartArt.AllNodes(6).Shapes.TextFrame2.TextRange.Text = "Wha?"
End Sub
I keep having an issue with some code in VBA Excel was looking for some help!
I am trying to sort through a list of names with corresponding phone numbers, checking for multiple names under the same phone number. Then post those names to a separate sheet.
So far my code is:
Sub main()
Dim cName As New Collection
For Each celli In Columns(3).Cells
Sheets(2).Activate
On Error GoTo raa
If Not celli.Value = Empty Then
cName.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
Sheets(3).Activate
Range("a1").Offset(celli.Row - 1, 0).Value = Range("a1").Offset(cName(celli.Value) - 1, 0).Value
Resume Next
End Sub
When I try to run the code it crashes Excel, and does not give any error codes.
Some things I've tried to fix the issue:
Shorted List of Items
Converted phone numbers to string using cstr()
Adjusted Range and offsets
I'm pretty new to all this, I only managed to get this far on the code with help from other posts on this site. Not sure where to go with this since it just crashes and gives me no error to look into. Any ideas are appreciated Thank you!
Updated:
Option Explicit
Dim output As Worksheet
Dim data As Worksheet
Dim hold As Object
Dim celli
Dim nextRow
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(3).Cells
On Error GoTo raa
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
End If
Next celli
On Error Resume Next
raa:
nextRow = output.Range("A" & Rows.Count).End(xlUp).Row + 1
output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
'data.Range("B1").Offset(celli.Row - 1, 0).Value = Range("B1").Offset(hold
Resume Next
End Sub
Update2:
Used hold.Exists along with an ElseIf to remove the GoTo's. Also changed it to copy and paste the row to the next sheet.
Sub main()
Set output = Worksheets("phoneFlags")
Set data = Worksheets("filteredData")
Set hold = CreateObject("Scripting.Dictionary")
For Each celli In data.Columns(2).Cells
If Not hold.Exists(CStr(celli.Value)) Then
If Not IsEmpty(celli.Value) Then
hold.Add Item:=celli.Row, Key:="" & celli.Value
Else
End If
ElseIf hold.Exists(CStr(celli.Value)) Then
data.Rows(celli.Row).Copy (Sheets("phoneFlags").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
'output.Range("A" & nextRow).Value = data.Range("A1").Offset(hold(celli.Value) - 1, 0).Value
End If
Next celli
End Sub
When developing code, don't try (or be afraid of) errors as they are pointers to help fix the code or the logic. As such, don't use On Error unless it is absolutely indicated in the coding algorithm (*). using On Error when not necessary only hides errors, does not fix them and when coding it is always better to avoid the errors in the first place (good logic).
When adding to the Dictionary, first check to see if the item already exists. The Microsoft documentation notes that trying to add an element that already exists causes an error. An advantage that the Dictionary object has over an ordinary Collection object in VBA is the .exists(value) method, which returns a Boolean.
The short answer to your question, now that I have the context out of the way, is that you can first check (if Not hold.exists(CStr(celli.Value)) Then) and then add if it does not already exist.
(*) As a side note, I was solving an Excel macro issue yesterday which took me most of the day to nut out, but the raising of errors and the use of debugging code helped me make some stable code rather than some buggy but kind-of-working code (which is what I was fixing in the first place). However, the use of error handling can be a short cut in some instances such as:
Function RangeExists(WS as Worksheet, NamedRange as String) As Boolean
Dim tResult as Boolean
Dim tRange as Range
tResult = False ' The default for declaring a Boolean is False, but I like to be explicit
On Error Goto SetResult ' the use of error means not using a loop through all the named ranges in the WS and can be quicker.
Set tRange = WS.Range(NamedRange) ' will error out if the named range does not exist
tResult = True
On Error Goto 0 ' Always good to explicitly limit where error hiding occurs, but not necessary in this example
SetResult:
RangeExists = tResult
End Function
I am having trouble running a VLookup inside a Change Event sub. I have tested all other lines of code and made sure they work, so it's only the VLookup that's not working.
For brief background, I have two sheets. Sheet1 contains the ID (where it could have multiple IDs on separate line, hence the SPLIT function used below), Sheet 2 contains the ID and its Description. What I wanted to do is perform a VLookup upon value change and insert description for each ID as comment into the cell.
The line that is not working for me is: Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False).
I'm not getting any errors but it jumps right to exitHandler without running the reminder of the logic. I'm certain that the ID exists in the table for the VLookup. If someone can help me point out why it is not working, I will be very appreciated!
Below is a snippet of the code where VLookup is used:
With Target
If .Comment Is Nothing Then
'do nothing
Else
.Comment.Delete
End If
If Target.Value = "" Then
.Comment.Delete
Else
If InStr(Target.Value, vbCrLf) = 0 Then
IDs = Split(Target.Value)
Else
IDs = Split(Target.Value, vbCrLf)
End If
For i = LBound(IDs) To UBound(IDs)
If commentText = "" Then
'Add description for ID as comment
commentText = Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
Else
'Keep on adding description for each ID as comment
commentText = commentText & vbCrLf & Application.WorksheetFunction.VLookup(IDs(i), Sheet2.Range("A3:B30"), 2, False)
End If
Next
.AddComment Text:=commentText
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
exitHandler:
Application.EnableEvents = True
End Sub
As the part of the varible defintions is missing, i would guess that commentText is defined as String. If Vlookup performs a search without a match it will return an error, so the variable has to be defined as Variant otherwise you will get a type mismatch. You wont see the error when you use an On Error Goto-Statement. Also then you should check after a Vlookup if no error occured, i.e with the IsError-Function.
Thank you so much for your replies. Indeed, it should be Application.VLookup and not Application.WorksheetFunction.VLookup. I also had to convert IDs(I) to CLng to prevent 2042 error. Changing commentText to Variant is also needed to see the error code.
In the end, this is what worked for me:
Application.VLookup(CLng(IDs(i)), Sheet2.Range("A3:B30"), 2, False)
Thanks again for all the help!
I hope someone can help- I'm hitting the dreaded "Out of memory or system resources" error with some code running in Excel and working with Outlook; from which the error originates.
Short description is it runs through a list of emails looking in the body/subject for a reference. If it finds it, it forwards the email item with the reference in the subject. MWE below; I'm not very experienced handling Outlook objects but I've spent nearly two hours trying different things with no luck. I can't use the GetTable() function since it doesn't include Body text data as far as I know (working off this), unless you can somehow add columns to include the body text?
If I run it in a freshly-opened Outlook session with only a dozen items it isn't a problem but I need it to work on hundreds of emails in one pop. Banging my head against a wall here. Thanks so much in advance!
Private Sub processMWE(ByVal oParent As Outlook.MAPIFolder)
Dim thisMail As Outlook.MailItem
Dim myItems As Outlook.Items
Dim emailindex As Integer
Dim folderpath As String
Dim refandType As Variant
Dim fwdItem
Set myItems = oParent.Items
folderpath = oParent.folderpath
'Starting at row 2 on the current sheet
i = 2
With myItems
'Data output to columns in Excel
For emailindex = 1 To .Count
Set thisMail = .Item(emailindex)
'i takes row value
Cells(i, 1).Value = folderpath
Cells(i, 2).Value = thisMail.Subject + " " + thisMail.Body
Cells(i, 3).Value = thisMail.SenderEmailAddress
Cells(i, 4).Value = thisMail.ReceivedTime
Cells(i, 6).Value = thisMail.Categories
'Reference from body/subject and a match type (integer)
refandType = extractInfo(Cells(i, 2))
'This is the reference
Cells(i, 5).Value = refandType(0)
'And this is the match type.
Select Case refandType(1)
Case 1, 2
'do nothing
Case Else
'For these match types, fwd the message
Set fwdItem = thisMail.Forward
fwdItem.Recipients.Add "#########"
fwdItem.Subject = Cells(i, 5) & " - " & thisMail.Subject
fwdItem.Send
'Edit original message category label
thisMail.Categories = "Forwarded"
thisMail.Save
'Note in spreadsheet
Cells(i, 7).Value = "Forwarded"
End If
End Select
i = i + 1
Next
End With
End Sub
Edit: New development: not only is it always hanging on the same line of code (thisMail.Body) it's actually doing it for specific mail items?! If I give it a batch of one of these problem messages it hangs immediately. Could it be something to do with character encoding or message length? Something that means thisMail.Body won't work that triggers a resources error?
Reason of the problem:
You are creating items without releasing them from memory -with these lines-
For emailindex = 1 To .Count
Set thisMail = .Item(emailindex)
Solution
Release the objects once you are done with them
End Select
i = i + 1
Set thisMail = Nothing
Next
End With
Common language explanation
In this scenario, think about VBA as a waiter, you are telling it that you are going to give some dishes to serve to the customers, you are giving all of them to it, but you never tell it to release them to the table, at one point, it will not be able to handle any more dishes ("Out of memory")
I have a listbox in a Diagram, when calling the function "drawDiagram" I want to get the selected Items of the listbox. Here is my code to do that:
Function DrawDiagram()
Dim x As Integer
Dim diaLst As ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 0 To diaLst.ListCount - 1
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
diaLst.ListCount correctly returns the number of Items in the list. But diaLst.Selected(x) does not work at all.
The Error message is:
German: "Die Selected-Eigenschaft des ListBox-Objektes kann nicht zugeordent werden"
English: "The Selected Property of the ListBox Object cannot be assigned" (or similar)
Does anyone know, what I did wrong?
thanks
natasia
By the way, this is the code I used to generate the list box in a chart sheet, in a separate function. At the moment when a button is clicked, the DrawDiagram function is called. The aim of the "DrawDiagram" function is to plot the selected items of the listbox in the diagram.
Set diaLst = ActiveSheet.ListBoxes.Add(ActiveChart.ChartArea.Width - 110, 5, 105, 150)
With diaLst
.Name = "DiaList"
.PrintObject = False
.MultiSelect = xlSimple
i = 2
While wTD.Cells(rowVarNames, i) <> ""
.AddItem wTD.Cells(rowVarNames, i)
i = i + 1
Wend
.Selected(3) = True
End With
first off, you must be dealing with a "Form" control (not an "ActiveX" one) otherwise you couldn't get it via .ListBoxes property of Worksheet class
I tested it in my environment (W7-Pro and Excel 2013) and found that (quite strangely to me) the Selected() property array is 1-based.
This remained even with Option Base 0 at the beginning of the module
Make sure Microsoft Forms 2.0 Object Library reference is added to your project
Function DrawDiagram()
Dim x As Long
Dim diaLst As MSForms.ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 1 To diaLst.ListCount
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
use Sheets("Sheet1").Shapes("List Box 1").OLEFormat.Object instead
I stumbled upon the same problem. The solution turned out to be simple, just had to tweak the code a litte bit and play around with the ListBox properites:
Function GetSelectedRowsFromListBox(lstbox As ListBox) As Collection
Create the collection
Dim coll As New Collection
Dim lst_cnt As Variant
lst_cnt = lstbox.ListCount
Dim arr_selectedVal As Variant
arr_selectedVal = lstbox.Selected
' Read through each item in the listbox
Dim i As Long
For i = 1 To lstbox.ListCount
' Check if item at position i is selected
If arr_selectedVal(i) Then
coll.Add i
End If
Next i
Set GetSelectedRowsFromListBox = coll
End Function
.Selected property returns a 1-based array with True/False values coresponding to rows in your multiple choice Form Control ListBox.
From that you can get the list of each value.
This solution is an expanded version of what is mentioned here, however this also complies with Form Control ListBox, no just ActiveX ListBox (which are 2 same but different things ;) ):
https://excelmacromastery.com/vba-listbox/
Hope that helps in the future!