Excel 2010 - VBA - Pull Table from a Website

[ZubaZ]

Hi - I'm very new to Excel VBA and I'm trying to learn some useful new things. I need to pull a certain table (I really don't want all of it, but I can delete columns later) from a webpage and then have it show up in Excel. I would really like to make it part of a macro. I tried creating a query using "from web" on the data tab, but it won't go because the table isn't easily identifiable. I thought I had the found an example of the code online, but I can't get it to work.

Website with table: Price % Losers - Yahoo! Finance

Here's what I'm hoping to have at the end:

Symbol	Name	Change (dollars)	Change (%)	Volume
CBMXW	CombiMatrix Corporation	0.32	-29.44%	3,371
BIOA-WT	BIOAMBER INC.	0.53	-23.13%	10,070
AFOP	Alliance Fiber Optic Products,	3.48	-22.40%	4,046,002
SIEB	Siebert Financial Corp.	0.79	-20.52%	115,812
MICTW	Micronet Enertec Technologies,	0.28	-20.16%	7,574
KONE	Kingtone Wirelessinfo Solution	1.91	-19.02%	55,635
PSMI	Peregrine Semiconductor Corp.	1.07	-16.09%	1,859,531
SPRO	SmartPros Ltd.	0.32	-13.33%	30,710
STLY	Stanley Furniture Company, Inc.	0.49	-13.10%	165,090
PFH	Cabco Tr Jcp 7.625 Common Stock	1.89	-11.52%	34,268
PCYG	Park City Group, Inc.	0.93	-10.78%	1,375,707
SSY	SunLink Health Systems, Inc. Co	0.13	-10.74%	191,634
JCP	J.C. Penney Company, Inc. Holdi	0.6	-10.56%	111,996,561
CPAH	CounterPath Corporation	0.13	-10.56%	48,695
DNB	Dun & Bradstreet Corporation (T	10.88	-10.22%	2,803,022
KBIO	KaloBios Pharmaceuticals, Inc.	0.29	-10.00%	2,837,149
TTWO	Take-Two Interactive Software,	1.84	-9.74%	21,554,877
ORMP	Oramed Pharmaceuticals Inc.	1.59	-9.48%	1,626,089
VSCI	Vision-Sciences, Inc.	0.13	-9.29%	174,669

<tbody>
</tbody>

Here's the code I have so far:

Sub GetTableFromWebsite()

    Sheets("Website Table Test").Select
    Range("A1").Select
    Dim x As Long, y As Long
    Dim htm As Object

    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://finance.yahoo.com/losers?e=us", False
        .send
        htm.body.innerhtml = .responsetext
    End With

    With htm.getelementbyid("yfsbar")
        For x = 0 To .Rows.Length - 1
            For y = 0 To .Rows(x).Cells.Length - 1
                Sheets(1).Cells(x + 1, y + 1).Value = .Rows(x).Cells(y).innertext
            Next y
        Next x
    End With

End Sub

However it doesn't do anything. I changed the url and the table id from the original, but it doesn't work. Any thoughts or help would be appreciated! Thanks!

 

[ZubaZ]

Side note: Can I edit a post? For some reason I'm not seeing that option?

Anyways, this is where it gets stuck: "For x = 0 To .Rows.Length - 1". I get the error "Run-time error '438': Object doesn't support this property or Method". When I do the "view source" option in my browser for this url and find the table and then copy the table and paste into excel it displays it just fine. So I know I can pull the table, I just can't figure out how to do it automatically.

 

[ukmikeb]

Hi

With slight modification to your code :-

Sub GetTableFromWebsite()
   Sheets("Website Table Test").Select
    Range("A1").Select
    Dim nextrow As Long
    Dim Cofs As Integer, I As Integer, tabno As Integer
    Dim htm As Object

    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://finance.yahoo.com/losers?e=us", False
        .send
        htm.body.innerhtml = .responsetext
    End With

    For Each tbl In htm.getElementsByTagName("TABLE")
        tabno = tabno + 1
        If tabno<> 5 Then GoTo NxtTbl
            For Each rw In tbl.Rows
                nextrow = nextrow + 1
                Set Rng = Range("A" & nextrow)
                Cofs = 0
                I = 0
                For Each Cl In rw.Cells
                    I = I + 1
                    If I = Int(I / 3) * 3 Then GoTo NxtCl
                        Rng.Offset(, Cofs).Value = Cl.outerText
                        Cofs = Cofs + 1
NxtCl:
                 Next Cl
             Next rw
NxtTbl:
      Next tbl
End Sub

The output looks like :-

Excel Workbook
	A	B	C	D
1	Symbol	Name	Change	Volume
2	WAFDW	Washington Federal, Inc.	2.26 (28.54%)	100
3	BIRT	Actuate Corporation	1.33 (18.25%)	809,989
4	EXTR	Extreme Networks, Inc.	1.18 (16.76%)	6,475,339
5	BBG	Bill Barrett Corporation Common	4.07 (14.70%)	5,691,418
6	DDD	3D Systems Corporation Common S	11.12 (14.68%)	33,126,349
7	MGT	MGT Capital Investments Inc Com	0.33 (14.55%)	251,384
8	CNIT	China Information Technology, I	0.63 (13.24%)	305,474
9	GSB	GlobalSCAPE, Inc. Common Stock	0.40 (11.57%)	306,327
10	VIRC	Virco Manufacturing Corporation	0.29 (11.24%)	38,205
11	ATLC	Atlanticus Holdings Corporation	0.32 (11.23%)	8,513
12	CLNE	Clean Energy Fuels Corp.	1.24 (10.75%)	4,147,310
Zubaz

Excel 2007

The table you are referencing is the 5th table on the webpage and the 3rd and 6th columns on the webpage are omitted.

hth

 

[ZubaZ]

Oh nice! I almost had a working version, but it wasn't nearly as efficient as this one. YaY! Thanks. I already tweaked it a tiny bit for another website and it seems to be working too. Thanks for the help. This website seems to be pretty much awesome for people with many skills helping people with few skills.

 

[ukmikeb]

Hi

I've been working on a solution which is independent of the position of the TABLE, currently the 5th table as follows :-

Sub GetTableFromWebsite()

    Sheets("Website Table Test").Select
    Dim Ptrtbl As Long, r As Long
    Dim htm As Object
    Dim elemCollection As Object

'   Clear the contents of previous output
    Range("A1:D" & Range("A" & Columns.Count).End(xlUp).Row).ClearContents
    
    Set htm = CreateObject("htmlFile")

    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://finance.yahoo.com/losers?e=us", False
        .send
        htm.body.innerhtml = .responsetext
    End With

'  Pull all the Tables on the current web page and store in elemCollection
Set elemCollection = htm.getelementsbytagname("TABLE")

Ptrtbl = 1
For Each elem In elemCollection
    Ptrtbl = Ptrtbl + 1
'    Find the id of the table ("yfsbar") we require
    If elem.ID <> "yfsbar" Then GoTo Nxtelem
    With elemCollection(Ptrtbl)
        For r = 0 To (.Rows.Length - 1)
 '           For each row in the table store the content from cells 0, 1, 3 and 4 in columns A, B, C and D
             Cells(r + 1, 1).Resize(, 4) = Array(.Rows(r).Cells(0).innertext, .Rows(r).Cells(1).innertext, _
                                                 .Rows(r).Cells(3).innertext, .Rows(r).Cells(4).innertext)
        Next r
    End With
    Exit For
Nxtelem:
Next elem
'
End Sub

Hopefully, the in code comments will enable you to adapt the code to handle other web pages/sites.

Should you find it necessary to explore the table setup on a website, the code in post #3 will serve that purpose with only slight modification.

hth

 

[ZubaZ]

Wow, very nice. Thanks for the updated version. I will put it to use immediately.