Scrape Data from Website

[dustinwlwenzel]

Hi, I am a farmer and I am looking to scrape the market data from this website, Farms.com. I am having some issues, this is what I have been trying, perhaps there is an easier way or different approach.

Thanks

Sub ab_milk()
Application.ScreenUpdating = False 

    Dim dataStartCell As Range
    Dim wb50 As Excel.Workbook
    Dim sht50 As Worksheet
    Set wb50 = ActiveWorkbook
    Set sht50 = wb50.Sheets("Sheet11")
    Set dataStartCell = sht50.Range("b2")
    dataStartCell.Parent.Cells.ClearContents
    sht50.Range("A1").Value = "Farm Prices"
      sht50.Range("A4").Value = "1"
  sht50.Range("a4").NumberFormat = "General"
    sht50.Range("a5").NumberFormat = "General"
    sht50.Range("A5").FormulaR1C1 = "=R[-1]C+1"
    sht50.Range("a5").AutoFill Destination:=sht50.Range("A5:A23"), Type:=xlFillDefault
    get_ab_milk Now, dataStartCell
    Application.ScreenUpdating = True

End Sub
Sub get_ab_milk(tradeDate As Date, destinationCell As Range)
Application.ScreenUpdating = False

    Dim URL As String
    Dim xmlhttp As MSXML2.xmlhttp
    Dim HTMLDoc As HTMLDocument
    Dim table As HTMLTable
    Dim tableRow As HTMLTableRow
    Dim tableCell As HTMLTableCell
    URL = "[url=http://www.farms.com/markets/]Farms.com[/url]"
    Set xmlhttp = New MSXML2.xmlhttp
    xmlhttp.Open "GET", URL, False
    xmlhttp.send
    Set HTMLDoc = New HTMLDocument
    HTMLDoc.body.innerHTML = xmlhttp.responseText
    Set table = HTMLDoc.getElementsByTagName("TABLE")(9)
    For Each tableRow In table.Rows
        For Each tableCell In tableRow.Cells
            destinationCell.Offset(tableRow.RowIndex, tableCell.cellIndex).Value = tableCell.innerText
        Next
    Next
    
    Application.ScreenUpdating = True

End Sub

 

[dustinwlwenzel]

Farms.com

That is the website with the data.

Thanks