arl16 arl16 - 1 month ago 8
HTML Question

Releasing htmlfile object correctly?

This code works the first time I try it, but when I tried copying it to a new Macro in Excel and pulling a table to another sheet, it generates nothing. So I figured that I needed to close/release my objects. Did I do it correctly? Can you see any other reason why it won't pull another HTML table for me? Thanks!

Dim oHTML As Object
Dim oTable As Object
Dim x As Long
Dim y As Long
Dim vData As Variant
Dim DataSheet As Worksheet

Set DataSheet = ActiveSheet
Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/" & range("a1").value, False
.send
oHTML.body.innerhtml = .responsetext
End With

For Each oTable In oHTML.Getelementsbytagname("table")
If oTable.classname = "fundstable" Then

ReDim vData(1 To oTable.Rows.Length, 1 To oTable.Rows(1).Cells.Length)

For x = 1 To UBound(vData)
For y = 1 To UBound(vData, 2)
vData(x, y) = oTable.Rows(x - 1).Cells(y - 1).innertext
Next y
Next x

With Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1)
.Resize(UBound(vData), UBound(vData, 2)).Value = vData
End With

End If
Next oTable

Set oHTML = Nothing
Set oTable = Nothing
Set htmlfile = Nothing


I should start off with, Thanks so much for taking a look at this - I really appreciate your time!

Your modified code works... but again,on the first tab I try it on. Looks like I do need to show the rest of my code, and give a better description of what I'm trying to do...

So, I have multiple sheets, each with a different category of funds. I have them all listed, and each sheet formatted the way I want the information from the tables displayed. Since when I pull the table, it is not in the format I wanted, my idea was to bring the data into sheet 2, then automatically copy cell to cell from sheet 2 to the cell I want it in the respective sheets.

So first, I clear the columns in Sheet 2 with:

Sheets("Sheet2").Select
Columns("A:T").Select
Range("A276").Activate
Selection.Delete Shift:=xlToLeft


Then I go back to the target sheet (in this case the Large Value Sheet), and copy a ticker from cell A49, and paste it in Sheet 2, cell A1.

Sheets("Large Value").Select
Range("A1").Select
ActiveCell.Offset((48 + (Z * 10)), 0).Range("A1").Select
Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
ActiveSheet.Paste


Then I begin your my (or your modified) code. (Above) It brings in the desired table, and I begin copying the cells I want back to the target sheet (again, Large Value)

Cells.Find(What:="fund return", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For A = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next A

Sheets("Sheet2").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For B = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next B

Sheets("Sheet2").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(-4, 1).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
For C = 1 To 4
Sheets("Sheet2").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.Copy
Sheets("Large Value").Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next C

Next Z


So this works the first time I do it, both with my code, and with your modified code. But as soon as I add a second tab, say "Large Growth", and copy the identical code over, replacing only the word "Value" with "Growth" throughout the code, it brings back nothing. Tickers are copied over correctly... actually the first ticker, but then it brings in nothing, and errors when it looks for "Fund Return", because nothing is there.

So my thought was that in some way, that middle part of the code was getting confused with the other macro. As soon as I delete the second macro attempt and second tab, macro 1 ("Large Value") works again.

But now that I think about it, your answer/tip makes sense - rather than have everything brought into Sheet(2), have the table brought into the target page, say cell A1000 - or whatever, just out of the way, so it's copying from the same sheet, rather than switching back and forth between sheets. I'm going to try that now and report back!

OK - I think I'm getting closer. But one more quick question - how to I just get the first table from the HTML, instead of the "For Each". There are two tables coming in, and the second one overwrites the first!

Answer

Let's give a try. Your code is fine, there's no reason why it shouldn't do with a similar page said that it has the same structure. So, what I would do is:

  • Replace the reference to the sheet, such as Sheet(2) into the pasting of the HTTP request response. Below the modified code (highlight with comments).

  • Make sure to place the macro in the right place, i.e. in a dedicated module of your workbook. To reach this purpose, open the VBA Editor (View / Macros), hence under the VBAProject/Modules right-click and insert a module. So, just copy and paste the code below.

  • Make sure the name of the fund is always placed into the Range A1 of the sheet you want the results in;

  • Make sure the link (have a look at it manually on a browser) is actually containing the same data you look for.

MODIFIED CODE:

Sub UpdateThisSheet() 'working on the current sheet, you don't need to make X identical macros ;)

Dim oHTML       As Object
Dim oTable      As Object
Dim x           As Long
Dim y           As Long
Dim vData       As Variant
Dim DataSheet As Worksheet

Set DataSheet = ActiveSheet
Set oHTML = CreateObject("HTMLFile")

With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", "http://www.marketwatch.com/investing/fund/" & ActiveSheet.Range("a1").Value, False 
.send
oHTML.body.innerhtml = .responsetext
End With

For Each oTable In oHTML.Getelementsbytagname("table")
If oTable.classname = "fundstable" Then

    ReDim vData(1 To oTable.Rows.Length, 1 To oTable.Rows(1).Cells.Length)

    For x = 1 To UBound(vData)
        For y = 1 To UBound(vData, 2)
            vData(x, y) = oTable.Rows(x - 1).Cells(y - 1).innertext
        Next y
    Next x

    With ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1) 'data goes in the current sheet, not always in sheet 2 !
        .Resize(UBound(vData), UBound(vData, 2)).Value = vData
    End With

Exit For 'NEW LINE TO ESCAPE THE CODE ONCE THE FIRST TABLE HAS BEEN REPORTED

End If
Next oTable

Set oHTML = Nothing
Set oTable = Nothing
Set htmlfile = Nothing

End Sub
Comments