Hi,
I recieved code from one of the forum users a little while back that worked great but over the last month or so the code keeps giving an error.
The attached code collects data from Coin Market Cap and places it in a "Temp" sheet but it does not run anymore for some reason.
Would really appreciate it if someone could get the code working again
Here is the code:
Public Sub Get2000RecordsFromCoinMarket()
Dim Ref_Sheet As Worksheet
Dim Portfolio As Worksheet
Dim Records As Variant
Dim Headers As Variant
Dim Cells As Variant
Dim s As String, URL As String
Dim i As Long, n As Long
Dim line As Long
Set Ref_Sheet = Sheets("Temp")
Set Portfolio = Sheets("DCS Portfolio")
URL = "https://api.coinmarketcap.com/v1/ticker/?start="
'Call ClearData(Ref_Sheet)
line = 0
For n = 0 To 1900 Step 100 'was 1900
s = GetDataBlock(URL & CStr(n))
Records = ParseBlock(s)
For i = LBound(Records) To UBound(Records)
If line = 0 Then
Headers = ParseRecordForHeaders(Records(i))
line = line + 1
Call PutDataInSheet(Ref_Sheet, line, Headers)
End If
line = line + 1
Cells = ParseRecordForValues(Records(i))
Call PutDataInSheet(Ref_Sheet, line, Cells)
Next i
Ref_Sheet.Cells(line, 1).Select
Next
'Call SetSheetHeader(Ref_Sheet)
Call SetSheetHeader(Portfolio)
End Sub
Private Function GetDataBlock(ByVal URL As String) As String
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", URL, False
http.send
GetDataBlock = http.responseText
Set http = Nothing
End Function
Private Function ParseBlock(ByRef s As String) As Variant
Dim p1 As Long, p2 As Long, i As Long
Dim s1 As String
Dim x As Variant, y As Variant
p1 = InStr(s, "[")
p2 = InStrRev(s, "]")
s1 = Mid(s, p1 + 1, p2 - (p1 + 1))
x = Split(s1, "}")
ReDim y(0 To UBound(x) - 1)
For i = LBound(x) To UBound(x) - 1
y(i) = Trim(Mid(x(i), InStr(x(i), "{") + 1))
Next
ParseBlock = y
End Function
Private Function ParseRecordForHeaders(ByRef rec As Variant) As Variant
Dim data As Variant, tmp As Variant, scol As Variant
Dim i As Long
data = Split(rec, ",")
ReDim Headers(LBound(data) To UBound(data))
For i = LBound(data) To UBound(data)
tmp = Split(data(i), ":")
scol = Split(tmp(0), """")
Headers(i) = scol(1)
Next
ParseRecordForHeaders = Headers
End Function
Private Function ParseRecordForValues(ByRef rec As Variant) As Variant
Dim data As Variant, tmp As Variant, sval As Variant
Dim i As Long
data = Split(rec, ",")
ReDim values(LBound(data) To UBound(data))
For i = LBound(data) To UBound(data)
tmp = Split(data(i), ":")
If Trim(tmp(1)) = "null" Then
values(i) = Null
Else
sval = Split(tmp(1), """")
values(i) = sval(1)
End If
Next
ParseRecordForValues = values
End Function
Private Sub PutDataInSheet(ByRef sh As Worksheet, ByVal line As Long, ByRef values As Variant)
Dim i As Long
With sh
For i = 0 To UBound(values)
If IsNull(values(i)) Then
.Cells(line, i + 1).Value = Null
ElseIf values(i) = "" Then
.Cells(line, i + 1).Value = Null
Else
.Cells(line, i + 1).Value = IIf(IsNumeric(values(i)), Val(values(i)), values(i))
End If
Next
End With
End Sub
Private Sub ClearData(ByRef sh As Worksheet)
With sh
.Rows("1:1").Font.Bold = False
.Select
.Range("A2").Select
ActiveWindow.FreezePanes = False
.Columns("A:Z").Clear 'Shift:=xlToLeft
End With
End Sub
Private Sub SetSheetHeader(ByRef sh As Worksheet)
With sh
.Columns("A:O").EntireColumn.AutoFit
.Rows("1:1").Font.Bold = True
.Select
.Range("A2").Select
ActiveWindow.FreezePanes = True
End With
End Sub
Bookmarks