Excel 2010 - VBA - Pull Table from a Website

ZubaZ

New Member
Joined
Feb 3, 2014
Messages
23
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:
SymbolNameChange (dollars)Change (%)Volume
CBMXWCombiMatrix Corporation0.32-29.44%3,371
BIOA-WTBIOAMBER INC.0.53-23.13%10,070
AFOPAlliance Fiber Optic Products,3.48-22.40%4,046,002
SIEBSiebert Financial Corp.0.79-20.52%115,812
MICTWMicronet Enertec Technologies,0.28-20.16%7,574
KONEKingtone Wirelessinfo Solution1.91-19.02%55,635
PSMIPeregrine Semiconductor Corp.1.07-16.09%1,859,531
SPROSmartPros Ltd.0.32-13.33%30,710
STLYStanley Furniture Company, Inc.0.49-13.10%165,090
PFHCabco Tr Jcp 7.625 Common Stock1.89-11.52%34,268
PCYGPark City Group, Inc.0.93-10.78%1,375,707
SSYSunLink Health Systems, Inc. Co0.13-10.74%191,634
JCPJ.C. Penney Company, Inc. Holdi0.6-10.56%111,996,561
CPAHCounterPath Corporation0.13-10.56%48,695
DNBDun & Bradstreet Corporation (T10.88-10.22%2,803,022
KBIOKaloBios Pharmaceuticals, Inc.0.29-10.00%2,837,149
TTWOTake-Two Interactive Software,1.84-9.74%21,554,877
ORMPOramed Pharmaceuticals Inc.1.59-9.48%1,626,089
VSCIVision-Sciences, Inc.0.13-9.29%174,669

<tbody>
</tbody>
Here's the code I have so far:
Code:
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!
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

ZubaZ

New Member
Joined
Feb 3, 2014
Messages
23
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

Well-known Member
Joined
Jul 10, 2009
Messages
2,757
Hi

With slight modification to your code :-
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
ABCD
1SymbolNameChangeVolume
2WAFDWWashington Federal, Inc.2.26 (28.54%)100
3BIRTActuate Corporation1.33 (18.25%)809,989
4EXTRExtreme Networks, Inc.1.18 (16.76%)6,475,339
5BBGBill Barrett Corporation Common4.07 (14.70%)5,691,418
6DDD3D Systems Corporation Common S11.12 (14.68%)33,126,349
7MGTMGT Capital Investments Inc Com0.33 (14.55%)251,384
8CNITChina Information Technology, I0.63 (13.24%)305,474
9GSBGlobalSCAPE, Inc. Common Stock0.40 (11.57%)306,327
10VIRCVirco Manufacturing Corporation0.29 (11.24%)38,205
11ATLCAtlanticus Holdings Corporation0.32 (11.23%)8,513
12CLNEClean 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

New Member
Joined
Feb 3, 2014
Messages
23
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. :biggrin:
 

ukmikeb

Well-known Member
Joined
Jul 10, 2009
Messages
2,757
Hi

I've been working on a solution which is independent of the position of the TABLE, currently the 5th table as follows :-
Code:
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

New Member
Joined
Feb 3, 2014
Messages
23
Wow, very nice. Thanks for the updated version. I will put it to use immediately.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,271
Messages
5,600,651
Members
414,399
Latest member
Ninjee

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top