VBA - Pulling Treasury Yields from Webpage into Excel

[VDIGX]

Hello,

I am currently trying to pull the results from a specified date in the table found here:

https://www.treasury.gov/resource-c.../Pages/TextView.aspx?data=yieldYear&year=2018

And would like to pull each rate into their own column

For example:
Date Specified - 01/09/18
Results - 1.27 1.44 1.60 1.78 1.98 2.09 2.33 2.46 2.55 2.72 2.88


Any help would be greatly apreciated!

 

[Domenic]

The following code first makes sure that a worksheet is active, then retrieves the desired information, and then it places it in the second row of the active sheet. Note that you'll need to set a reference to Microsoft Internet Controls, and Microsoft HTML Object Library, under VBE > Tools > References.

Option Explicit

Sub test()


    'Set a reference (VBE > Tools > References) to the following libraries:
    '   1) Microsoft Internet Controls
    '   2) Microsoft HTML Object Library
    
    Dim IE As New SHDocVw.InternetExplorer
    Dim HTMLDoc As New mshtml.HTMLDocument
    Dim HTMLTable As mshtml.HTMLTable
    Dim HTMLRow As mshtml.HTMLTableRow
    Dim i As Long
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    With IE
        .Visible = True
        .navigate "https://www.treasury.gov/resource-center/data-chart-center/interest-rates/Pages/TextView.aspx?data=yieldYear&year=2018"
        Do While .Busy Or .readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
    End With
    
    Set HTMLDoc = IE.document
    
    For Each HTMLTable In HTMLDoc.getElementsByTagName("table")
        If HTMLTable.getAttribute("classname") = "t-chart" Then
            Exit For
        End If
    Next HTMLTable
    
    If Not HTMLTable Is Nothing Then
        For Each HTMLRow In HTMLTable.Rows
            If HTMLRow.Cells(0).innerText = "01/09/18" Then
                For i = 0 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If
        Next HTMLRow
    End If
    
    Set IE = Nothing
    Set HTMLDoc = Nothing
    Set HTMLTable = Nothing
    Set HTMLRow = Nothing
    
End Sub

If you prefer, you can enter the specified date in a cell within the worksheet, let's say cell A2, and then have the results listed accordingly. If so, replace...

            If HTMLRow.Cells(0).innerText = "01/09/18" Then
                For i = 0 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If

with

            If HTMLRow.Cells(0).innerText = Format(Range("A2").Value, "mm/dd/yy") Then
                For i = 1 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If

Hope this helps!

 

[VDIGX]

The following code first makes sure that a worksheet is active, then retrieves the desired information, and then it places it in the second row of the active sheet. Note that you'll need to set a reference to Microsoft Internet Controls, and Microsoft HTML Object Library, under VBE > Tools > References.

Option Explicit

Sub test()


    'Set a reference (VBE > Tools > References) to the following libraries:
    '   1) Microsoft Internet Controls
    '   2) Microsoft HTML Object Library
    
    Dim IE As New SHDocVw.InternetExplorer
    Dim HTMLDoc As New mshtml.HTMLDocument
    Dim HTMLTable As mshtml.HTMLTable
    Dim HTMLRow As mshtml.HTMLTableRow
    Dim i As Long
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    With IE
        .Visible = True
        .navigate "https://www.treasury.gov/resource-center/data-chart-center/interest-rates/Pages/TextView.aspx?data=yieldYear&year=2018"
        Do While .Busy Or .readyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
    End With
    
    Set HTMLDoc = IE.document
    
    For Each HTMLTable In HTMLDoc.getElementsByTagName("table")
        If HTMLTable.getAttribute("classname") = "t-chart" Then
            Exit For
        End If
    Next HTMLTable
    
    If Not HTMLTable Is Nothing Then
        For Each HTMLRow In HTMLTable.Rows
            If HTMLRow.Cells(0).innerText = "01/09/18" Then
                For i = 0 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If
        Next HTMLRow
    End If
    
    Set IE = Nothing
    Set HTMLDoc = Nothing
    Set HTMLTable = Nothing
    Set HTMLRow = Nothing
    
End Sub

If you prefer, you can enter the specified date in a cell within the worksheet, let's say cell A2, and then have the results listed accordingly. If so, replace...

            If HTMLRow.Cells(0).innerText = "01/09/18" Then
                For i = 0 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If

with

            If HTMLRow.Cells(0).innerText = Format(Range("A2").Value, "mm/dd/yy") Then
                For i = 1 To HTMLRow.Cells.Length - 1
                    Cells(2, i + 1).Value = HTMLRow.Cells(i).innerText
                Next i
            End If

Hope this helps!

Thank you so much Domenic! This helped a ton!