I have written a getprice function for retrieving stock tickers from yahoo and bitcoin prices from an online api. However the code for bitcoin results in an #value! in my excel cell. But it performs fine when I run the function from the immediate box in VB. I sense it's some sort of compatibility problem but I've exhausted my troubleshooting knowledge. Any help or pointers would be appreciated!
here is the file https://drive.google.com/file/d/0B-CQNUWfWnMzQTA5MW9Vb3NiLXc/view?usp=sharing
code:
Function GetPrice(strTicker As String, Optional dtDate As Variant)
Debug.Print "Getting Price..."
' Date is optional - if omitted, use today. If value is not a date, throw error.
If IsMissing(dtDate) Then
dtDate = Date
Else
If Not (IsDate(dtDate)) Then
GetPrice = CVErr(xlErrNum)
Debug.Print "Date problem!"
End If
End If
' Define variables
Dim dtPrevDate As Date
Dim strURL As String, strCSV As String, strDate As String, strRows() As String, strColumns() As String
Dim priceArray() As Variant
Dim wb As Workbook
Dim dbClose As Double
dbClose = 1 ' default for if price not found
' for stock tickers look at a weeks worth of data in case date is weekend
dtPrevDate = dtDate - 7
' Treat bitcoin separately and compile CSV with all BTC data
If strTicker = "BTCUSD" Then
' go to the URL
strURL = "https://api.bitcoinaverage.com/history/USD/per_day_all_time_history.csv"
priceArray = CsvToArray(strURL) 'convert to array
' Bitcoin date search
strDate = CStr(dtDate)
Debug.Print "Date: "; strDate
' side question but i dont understand why this vloopkup doesnt work???
'dbClose = Application.VLookup(DateValue(strDate), priceArray, 4, False) ' lookup value in column d
'try parsing array manually instead
For i = LBound(priceArray) To UBound(priceArray)
If CStr(priceArray(i, 1)) = strDate Then
dbClose = CDbl(priceArray(i, 4))
Exit For
Else
dbClose = 1
End If
Next i
' For all other tickers
' Compile the request URL with start date and end date
Else
Debug.Print "stock ticker:"; strTicker
strURL = "http://ichart.yahoo.com/table.csv?s=" & strTicker & _
"&a=" & Month(dtPrevDate) - 1 & _
"&b=" & Day(dtPrevDate) & _
"&c=" & Year(dtPrevDate) & _
"&d=" & Month(dtDate) - 1 & _
"&e=" & Day(dtDate) & _
"&f=" & Year(dtDate) & _
"&g=d&ignore=.csv"
' Declare an object as the http data
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
' The most recent information is in row 2, just below the table headings.
' The price close is the 5th entry
strRows() = Split(strCSV, Chr(10)) ' split the CSV into rows
strColumns = Split(strRows(1), ",") ' split the relevant row into columns. 1 means 2nd row, starting at index 0
dbClose = strColumns(4) ' 4 means: 5th position, starting at index 0
End If
If dbClose = 1 Then
GetPrice = "Not Found"
Debug.Print "GetPrice"; GetPrice
Else
GetPrice = dbClose
Debug.Print "Price: "; GetPrice
End If
Set http = Nothing
End Function
Function CsvToArray(filepath As String) As Variant
Dim wb As Workbook
Dim array1() As Variant
Application.ScreenUpdating = False
Set wb = Workbooks.Open(filepath)
' THIS LINE SEEMS TO CAUSE THE PROBLEM
array1 = wb.Sheets(1).Range("A1").CurrentRegion.Value
wb.Close False
CsvToArray = array1
Application.ScreenUpdating = True
End Function
I don't think you can access the bitcoin url the way that you're trying to do so. Excel can't actually trigger the file download & and the file path that you're trying to use for the CsvToArray method doesn't make sense.
Instead, try something along these lines (you will need some additional logic to find the desired bitcoin date, however this should move you in the right direction:
Function GetPrice(strTicker As String, Optional dtDate As Variant)
Debug.Print "Getting Price..."
' Date is optional - if omitted, use today. If value is not a date, throw error.
If IsMissing(dtDate) Then
dtDate = Date
Else
If Not (IsDate(dtDate)) Then
GetPrice = CVErr(xlErrNum)
Debug.Print "Date problem!"
End If
End If
' Define variables
Dim dtPrevDate As Date
Dim strURL As String, strCSV As String, strDate As String, strRows() As String, strColumns() As String
Dim priceArray() As Variant
Dim wb As Workbook
Dim dbClose As Double
Dim desiredRow, desiredCol as Long
dbClose = 1 ' default for if price not found
' for stock tickers look at a weeks worth of data in case date is weekend
dtPrevDate = dtDate - 7
' Treat bitcoin separately and compile CSV with all BTC data
If strTicker = "BTCUSD" Then
' go to the URL
strURL = "https://api.bitcoinaverage.com/history/USD/per_day_all_time_history.csv"
' For all other tickers
' Compile the request URL with start date and end date
Else
Debug.Print "stock ticker:"; strTicker
strURL = "http://ichart.yahoo.com/table.csv?s=" & strTicker & _
"&a=" & Month(dtPrevDate) - 1 & _
"&b=" & Day(dtPrevDate) & _
"&c=" & Year(dtPrevDate) & _
"&d=" & Month(dtDate) - 1 & _
"&e=" & Day(dtDate) & _
"&f=" & Year(dtDate) & _
"&g=d&ignore=.csv"
End If
' Declare an object as the http data
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
' The most recent information is in row 2, just below the table headings.
' The price close is the 5th entry
strRows() = Split(strCSV, Chr(10)) ' split the CSV into rows
If strTicker = "BTCUSD" Then
'ADD LOGIC HERE TO FIND DESIRED DATE
desiredRow = UBound(strRows)
desiredCol = 2
Else
desiredRow = 2
desiredCol = 5
End If
strColumns = Split(strRows(desiredRow - 1), ",") ' split the relevant row into columns. 1 means 2nd row, starting at index 0
dbClose = strColumns(desiredCol - 1) ' 4 means: 5th position, starting at index 0
If dbClose = 1 Then
GetPrice = "Not Found"
Debug.Print "GetPrice"; GetPrice
Else
GetPrice = dbClose
Debug.Print "Price: "; GetPrice
End If
Set http = Nothing
End Function
code with fix
Function GetPrice(strTicker As String, Optional dtDate As Variant)
Debug.Print "Getting Price..."
' Date is optional - if omitted, use today. If value is not a date, throw error.
If IsMissing(dtDate) Then
dtDate = Date
Else
If Not (IsDate(dtDate)) Then
GetPrice = CVErr(xlErrNum)
Debug.Print "Date problem!"
End If
End If
' Define variables
Dim dtPrevDate As Date
Dim strURL As String, strCSV As String, strDate As String, strRows() As String, strColumns() As String
Dim priceArray() As Variant
Dim wb As Workbook
Dim dbClose As Double
dbClose = 1 ' default for if price not found
' for stock tickers look at a weeks worth of data in case date is weekend
dtPrevDate = dtDate - 7
' Treat bitcoin separately and compile CSV with all BTC data
If strTicker = "BTCUSD" Then
' go to the URL
strURL = "https://api.bitcoinaverage.com/history/USD/per_day_all_time_history.csv"
'priceArray = CsvToArray(strURL) 'convert to array
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
'split csv into rows
strRows() = Split(strCSV, Chr(10))
' Bitcoin date search
numDate = CDate(dtDate)
Debug.Print "Date: "; CStr(dtDate)
'compare dates in strCSV to dtDate
For i = 1 To UBound(strRows())
rowInfo = Split(strRows(i), ",") 'divide the rows by commas
rowDate = Split(rowInfo(0), " ") 'look at the date/time and take the date only
rowDate = CDate(rowDate(0)) 'convert the date from string to CDate
If rowDate >= numDate Then 'Make the comparison
dbClose = CDbl(rowInfo(3)) 'set the price as daily avg
Exit For 'exit for loop
Else
dbClose = 1
End If
Next i
' For all other tickers
' Compile the request URL with start date and end date
Else
Debug.Print "stock ticker:"; strTicker
strURL = "http://ichart.yahoo.com/table.csv?s=" & strTicker & _
"&a=" & Month(dtPrevDate) - 1 & _
"&b=" & Day(dtPrevDate) & _
"&c=" & Year(dtPrevDate) & _
"&d=" & Month(dtDate) - 1 & _
"&e=" & Day(dtDate) & _
"&f=" & Year(dtDate) & _
"&g=d&ignore=.csv"
' Declare an object as the http data
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strCSV = http.responseText
' The most recent information is in row 2, just below the table headings.
' The price close is the 5th entry
strRows() = Split(strCSV, Chr(10)) ' split the CSV into rows
strColumns = Split(strRows(1), ",") ' split the relevant row into columns. 1 means 2nd row, starting at index 0
dbClose = strColumns(4) ' 4 means: 5th position, starting at index 0
End If
If dbClose = 1 Then
GetPrice = 1
Debug.Print "GetPrice"; GetPrice
Else
GetPrice = dbClose
Debug.Print "Price: "; GetPrice
End If
Set http = Nothing
End Function
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.