Parsing JSON to Excel - LOOP - json

Question

I have a code that gets historical stock prices by parsing JSON. I need to get the "Close" price on a specific date. I need the code to read the date from an Excel cell and paste the price corresponding to the date. Here is an example:
https://cloud.iexapis.com/stable/stock/AAPL/chart/1m?token=pk_98e61bb72fd84b7d8b5f19c579fd0d9d
Below is my code, but I need to modify it so it can loop to find the date required:
Sub getHistoricalData()
'Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim symbol As Variant
Dim n As Integer
Dim lastrow As Long
Dim myrequest As Variant
Dim i As Variant
Set wb = ActiveWorkbook
Set ws = Sheets("Sheet1")
ws.Activate
'Last row find
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = ws.Range("A3:A" & lastrow)
'Clear Prior Prices
ws.Range("k3:k" & lastrow).ClearContents
n = 3
'Get Symbols list
For Each symbol In rng
Set myrequest = CreateObject("WinHttp.WinHttpRequest.5.1")
myrequest.Open "Get", "https://cloud.iexapis.com/stable/stock/" & symbol & "/chart/1m?token=pk_98e61bb72fd84b7d8b5f19c579fd0d9d" 'updated 06/15/2019
'Debug.Print myrequest.ResponseText
Dim Json As Object
Set Json = JsonConverter.ParseJson(myrequest.ResponseText)
'MsgBox (myrequest.ResponseText)
i = Json("Close")
ws.Range(Cells(n, 2), Cells(n, 2)) = i
n = n + 1
Next symbol
ws.Columns("k").AutoFit
'MsgBox ("Data is downloaded.")
ws.Range("k3:k" & lastrow).HorizontalAlignment = xlGeneral
ws.Range("k3:k" & lastrow).NumberFormat = "$#,##0.00"
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub
For Example, I need to extract the closing price on 06/06/2019 for each stock symbol.

Answer 1

Json parser would be an ideal choice. You can however also regex out from the response and handle cases of http errors i.e. where not a successful connection to desired page, as well as and date not found. I read the date from cell A1. The date is formatted unambiguously as yyyy-mm-dd. The tickers are read into an array which is looped - this is faster. Results are stored in an array and written out once to sheet - also faster.
Option Explicit
Public Sub GetClosePrices()
Dim lastRow As Long, url As String, ws As Worksheet, tickers(), dateString As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
dateString = Format$(.Range("A1").Value, "yyyy-mm-dd")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastRow >= 3 Then
.Range("K3:K" & lastRow).ClearContents
tickers = Application.Transpose(.Range("A3:A" & lastRow).Value)
Else
Exit Sub
End If
End With
Dim s As String, re As Object, p As String, r As String, prices(), i As Long
ReDim prices(1 To UBound(tickers))
p = """DATE_HERE"",""open"":[0-9.]+,""close"":(.*?)," 'Format must be YYYY-MM-DD
p = Replace$(p, "DATE_HERE", dateString)
url = "https://cloud.iexapis.com/stable/stock/TICKER_HERE/chart/1m?token=pk_98e61bb72fd84b7d8b5f19c579fd0d9d"
Set re = CreateObject("VBScript.RegExp")
With CreateObject("MSXML2.XMLHTTP")
For i = LBound(tickers) To UBound(tickers)
.Open "GET", Replace$(url, "TICKER_HERE", tickers(i)), False
.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
.send
If .Status = 200 Then
s = .responseText
r = GetValue(re, s, p)
Else
r = "Failed connection"
End If
prices(i) = r
s = vbNullString
Next
End With
ws.Cells(3, "K").Resize(UBound(prices), 1) = Application.Transpose(prices)
End Sub
Public Function GetValue(ByVal re As Object, ByVal inputString As String, ByVal pattern As String) As String
With re
.Global = True
.pattern = pattern
If .test(inputString) Then ' returns True if the regex pattern can be matched agaist the provided string
GetValue = .Execute(inputString)(0).submatches(0)
Else
GetValue = "Not found"
End If
End With
End Function
Regex explanation for an example date (try it):

Answer 2

The JSON response is an array of objects (exposed by the VBA-JSON library as a Collection of Dictionaries), so you need to loop over them and find the one of interest, based on the date:
Dim closePrice
Set Json = JsonConverter.ParseJson(myrequest.ResponseText)
For Each o in Json
if o("date") = "2019-06-06" Then
closePrice = o("close")
exit for
end if
Next o