VBA - Pulling Treasury Yields from Webpage into Excel

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
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.

Code:
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...

Code:
            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

Code:
            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

New Member
Joined
Apr 19, 2016
Messages
4
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.

Code:
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...

Code:
            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

Code:
            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!
 

Watch MrExcel Video

Forum statistics

Threads
1,122,577
Messages
5,596,996
Members
414,116
Latest member
sfullnet

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