VBA Cell Referenced Web Query

Question

I have this code that is supposed to reference column "D" for the company name and perform a query at yahoo finance for the stock symbol. It works great some of the time, others instead of the stock symbol I get "adchoices". I am not sure what I am doing wrong and any help would be more than appreciated. Here is the code:

Sub Company2Ticker()

'Reference Microsoft internet internet controls and microsoft html library

For i = 2 To 3000
On Error Resume Next
If Len(Cells(i, 1).Value) = 0 Then Exit For

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

IE.navigate "http://finance.yahoo.com/lookup?s=" & Cells(i, 4).Value

Do
DoEvents
Loop Until IE.readystate = readystate_complete
Dim Doc As HTMLDocument
Set Doc = IE.document
Dim sDD As String
sDD = Trim(Doc.getElementsbyTagName("td")(2).innertext)
Cells(i, 6) = sDD
Next i
End Sub

Answer 1

The web page you are querying displays ads. My guess is that some of these ads (or any other randomly appearing <table>) use <td> elements before the ones you are looking for. The getElementsbyTagName() method returns the first results it finds, so you won't get what you expect in this case.

I suggest replacing sDD = Trim(Doc.getElementsbyTagName("td")(2).innertext) by something like:

Dim j As Integer
j = 2
Do
    sDD = Trim(Doc.getElementsbyTagName("td")(j).innertext)
    j = j + 1
Loop While sDD = "adchoices"

Edit the Loop While condition until you can filter any ad-related result.

Hope it helps.