+ Reply to Thread
Results 1 to 5 of 5

VBA Code not working anymore to collect data from Coinmarketcap

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    07-13-2014
    Location
    Three Rivers
    MS-Off Ver
    365
    Posts
    127

    VBA Code not working anymore to collect data from Coinmarketcap

    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

  2. #2
    Administrator 6StringJazzer's Avatar
    Join Date
    01-27-2010
    Location
    Tysons Corner, VA, USA
    MS-Off Ver
    MS 365 Family 64-bit 2404
    Posts
    24,802

    Re: VBA Code not working anymore to collect data from Coinmarketcap

    Quote Originally Posted by Rudidw View Post
    the code keeps giving an error.
    When asking for help with an error, always tell us what the error is.
    Jeff
    | | |會 |會 |會 |會 | |:| | |會 |會
    Read the rules
    Use code tags to [code]enclose your code![/code]

  3. #3
    Forum Contributor
    Join Date
    07-13-2014
    Location
    Three Rivers
    MS-Off Ver
    365
    Posts
    127

    Re: VBA Code not working anymore to collect data from Coinmarketcap

    Apologies! I get the following error:

    Runtime error 5

    Invalid procedure call or argument

    When I click on debug it highlights this piece of the code-
    s1 = Mid(s, p1 + 1, p2 - (p1 + 1))
    Also see image attachedAttachment 669768

  4. #4
    Administrator 6StringJazzer's Avatar
    Join Date
    01-27-2010
    Location
    Tysons Corner, VA, USA
    MS-Off Ver
    MS 365 Family 64-bit 2404
    Posts
    24,802

    Re: VBA Code not working anymore to collect data from Coinmarketcap

    When I enter your URL into a browser I get this message. You are using an obsolete API.

    {"statusCode": 410,"error": "Gone","message": "WARNING: This API is now offline. Please switch to the new CoinMarketCap API. (https://pro.coinmarketcap.com/migrate/)"}

  5. #5
    Forum Contributor
    Join Date
    07-13-2014
    Location
    Three Rivers
    MS-Off Ver
    365
    Posts
    127

    Re: VBA Code not working anymore to collect data from Coinmarketcap

    Thank you yes I believe that was the problem.

    I was able to get my workbook working again by following the instructions on this page:
    https://medium.com/@moralesgersonpa/...p-49759f10a69d

    Thanks for the help

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Retrieve Data From New Coinmarketcap.com API
    By Rudidw in forum Excel Programming / VBA / Macros
    Replies: 9
    Last Post: 05-11-2019, 09:12 AM
  2. Code (Extracting Data from website) not working anymore, and don't know why...
    By KomicJ in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 11-17-2015, 10:16 AM
  3. Why are my VBA code not working anymore on other machines?
    By Viennej in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 08-27-2015, 05:20 AM
  4. Macro/VBA code for COLLECT DATA FROM VARIOUS PAGES OF ONE WEBSITE..
    By gunjan.nasit in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 05-19-2013, 03:26 PM
  5. VBA code not working anymore
    By random379 in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 05-24-2012, 03:01 AM
  6. VBA code "Application.FileSearch" not working in XL 2007 anymore
    By leecs in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-08-2010, 01:22 AM
  7. Code to insert functions not working anymore
    By Mike K in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-22-2006, 09:00 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1