VBA app configured with JSON. Data from bitCoin API

bitCoinX.vba

Option Explicit
Public Sub btcSetup()
    'destroy this workbook and make an empty one
    btcCreateWorkBook
    btcMakeDashboard
    
End Sub
Public Function btcMakeDashboard(Optional dashType As String = "ticker") As Boolean

    ' this creates an empty dashboard based on the latest ticker values
    ' should setup the workbook sheets first
    Dim boardName As String, co As Collection, jobDash As cJobject, jobSetup As cJobject, jobWork As cJobject, joc As cJobject, _
        prefix As String, ws As Worksheet, rhead As Range, r As Range, rData As Range, manifest As cJobject, jor As cJobject

    Set manifest = getManifest()
    
    ' find out all about this kind of dashboard
    Set jobDash = findInChildren(manifest.child("dashboards"), "type", dashType)
    If jobDash Is Nothing Then
        MsgBox "cant find type " & dashType & " in dashboard description"
        Exit Function
    End If
    
    ' delete the existing dashboard
    Set ws = sheetExists(jobDash.child("name").toString, False)
    If Not ws Is Nothing Then
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    End If
    
    ' make a new one
    Set ws = Sheets.add(, Sheets(manifest.toString("manifest.name")))
    ws.name = jobDash.child("name").toString
    Set rData = ws.Cells(1, 1)
    
    ' get whats in this type
    Set jobSetup = findInChildren(manifest.child("setup.types"), "type", dashType)
    If jobSetup Is Nothing Then
        MsgBox "cant find type " & dashType & " in setup description"
        Exit Function
    End If

    ' get what work needs done in this type
    Set jobWork = findInChildren(manifest.child("work"), "type", dashType)
    If jobWork Is Nothing Then
        MsgBox "cant find type " & dashType & " in work description"
        Exit Function
    End If

    ' add the columns
    colorizeCell ws.Cells(1, 1).Resize(, jobSetup.child("options.columns").children.count + 1), _
                                                jobSetup.toString("options.fillColor")
    rData.value = dashType
    For Each joc In jobSetup.child("options.columns").children
        With rData.Offset(, joc.childIndex)
            .value = joc.value
            ' if this is a date convert column, set the appropriate format
            If Not jobSetup.child("options").childExists("convertTimes") Is Nothing Then
                For Each jor In jobSetup.child("options.convertTimes").children
                    If LCase(jor.child("to").value) = LCase(.value) Then
                        .EntireColumn.NumberFormat = jobDash.toString("timeFormat")
                    End If
                Next jor
            End If
        End With
    Next joc
    
   ' now add the rows
    For Each jor In jobWork.child("venues").children
        rData.Offset(jor.childIndex).value = jor.value
        ' add the data as formulas
        For Each joc In jobSetup.child("options.columns").children
            rData.Offset(jor.childIndex, joc.childIndex).Formula = _
                Replace("=INDIRECT('" & dashType & "_'&$a" & 1 + jor.childIndex & "&'!'&CHAR(CODE('A')+COLUMN()-2)&2)", "'", q)
        Next
    Next jor

 'finally refit for the data
    toEmptyBox(wholeSheet(ws.name)).EntireColumn.AutoFit
    manifest.tearDown

End Function

Public Sub doBTCUpdates()
  Dim job As cJobject
  
  ' update all data from rest API
  With getManifest
    For Each job In .child("work").children
        If Not btcProcess(.self, job, .child("url").toString) Then Exit For
    Next
    .tearDown
  End With
  
    
End Sub

Private Function btcProcess(manifest As cJobject, workItem As cJobject, urlStem As String) As Boolean
    ' process a piece of btc pdate work
    Dim r As Range, workType As String, job As cJobject, url As String, _
            sheetName As String, joc As cJobject, jor As cJobject, joh As cJobject, _
            jOptions As cJobject, ds As cDataSet, dr As cDataRow, jobHouse As cJobject, _
            wsConsolidate As Worksheet, dc As cCell, maxRows As Long

    
    workType = LCase(workItem.toString("type"))
    'find the options associated with this type
    For Each job In manifest.child("setup.types").children
        If job.toString("type") = workType Then
            Set jOptions = job.child("options")
            Exit For
        End If
    Next job
    
    If jOptions Is Nothing Then
        MsgBox ("cant find worktype " & workType & " in manifest setup")
        Exit Function
    End If
    
    btcProcess = True
    'will any any housekeeping be required?
    Set jobHouse = workItem.childExists("housekeeping")
    If Not jobHouse Is Nothing Then
        For Each joh In jobHouse.children
            If Not joh.childExists("consolidate") Is Nothing Then
                ' need to clear out this consolidated view
                Set wsConsolidate = getSheetOrCreate(workType & "_" & joh.toString("consolidate.name"), _
                                    Sheets(manifest.toString("manifest.name")))
                wsConsolidate.Cells.clear
                
            End If
        Next joh
    End If
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each job In workItem.child("venues").children
        url = urlStem + LCase(job.toString) & "/" & workType
        sheetName = workType & "_" & job.toString
         
        ' check if we are inserting
        If LCase(jOptions.toString("action")) = "insert" Then
            wholeSheet(sheetName).Resize(1).Offset(1).EntireRow.insert xlDown, xlFormatFromRightOrBelow
        End If

        ' now its a common query
        With restQuery(sheetName, , , , url, jOptions.child("resultsStem").toString, , _
                Not jOptions.child("manual").value, LCase(jOptions.child("action").toString = "clear"), , True)
            ' this is a manual populate for 'depth' which has no object keys
            If jOptions.child("manual").value Then
                Set r = .dset.headingRow.where.Resize(1, 1)
                For Each jor In .datajObject.children
                    For Each joc In jor.children
                        r.Offset(jor.childIndex, joc.childIndex - 1).value = joc.value
                    Next joc
                Next jor
            End If
            .tearDown
        End With

        ' any dates needs calculated?
        If Not jOptions.childExists("convertTimes") Is Nothing Then
            Set ds = New cDataSet
            With ds.populateData(wholeSheet(sheetName), , , , , , True)
                For Each jor In jOptions.child("convertTimes").children
                    .column(jor.toString("to")).where.NumberFormat = jOptions.toString("timeFormat")
                    For Each dr In .rows
                        dr.cell(jor.toString("to")).where.value = _
                            dateFromUnix(dr.cell(jor.toString("from")).toString)
                    Next dr
                Next jor
                .tearDown
            End With
        End If
        
        ' house keeping?
        If Not jobHouse Is Nothing Then
            ' we're going to need to take a look at the data now in this sheet
            Set ds = New cDataSet
            ds.populateData wholeSheet(sheetName), , , , , , True
            
            maxRows = ds.rows.count
            For Each joh In jobHouse.children
                
                ' need to keep the rows at some maximum number
                If Not joh.childExists("trim") Is Nothing Then
                    maxRows = joh.child("trim.rows").value
                    If (ds.rows.count > maxRows) Then
                        ds.where.Resize(ds.rows.count - maxRows).Delete
                    End If
                    
                End If
                
            Next joh
            
            
            ' any consolidation need to happen ?
            If Not wsConsolidate Is Nothing Then
                ' copy headings
                ds.headingRow.where.Copy
                With wsConsolidate.Cells(1, 1)
                    .Resize(1, ds.headingRow.where.columns.count).Offset(, 1).PasteSpecial xlPasteAll
                    ' make a new column for the venue stamp
                    .value = "Venue"
                    .Offset(, 1).Copy
                    .PasteSpecial xlPasteFormats
                End With
                ' and append the data
                Set r = wsConsolidate.Cells(1, 1) _
                    .Offset(wsConsolidate.Cells.find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row - 1)
                    
                For Each dr In ds.rows
                    ' may have been trimmed....
                    If dr.row > maxRows Then Exit For
                    
                    Set r = r.Offset(1)
                    'stamp the venue
                    r.value = job.toString
                    ' copy the data
                    For Each dc In dr.columns
                        r.Offset(, dc.column).value = dc.value
                    Next dc
                Next dr
            End If
                
            ds.tearDown
        End If

        
        'finally refit for the data
        toEmptyBox(wholeSheet(sheetName)).EntireColumn.AutoFit
        If Not wsConsolidate Is Nothing Then
            toEmptyBox(wsConsolidate.Cells).EntireColumn.AutoFit
        End If
        ' and the dashboard will change
        Set joc = findInChildren(manifest.child("dashboards"), "type", workType)
        If Not joc Is Nothing Then
            toEmptyBox(wholeSheet(joc.toString("name"))).EntireColumn.AutoFit
        End If
        
        
    Next job
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

Public Function getManifest() As cJobject
  ' this is the work manifest
  Dim job As cJobject
  Dim workRange As Range
  Set workRange = Range("manifest!a1")
  With JSONParse(workRange.value)
    With .add("manifest")
        .add "range", SAd(workRange)
        .add "name", workRange.Worksheet.name
    End With
    Set getManifest = .self
  End With
  
End Function


Private Function btcCreateWorkBook(Optional check As Boolean = True) As Boolean
    ' delete dashboard, plus all potential sheets of interest, and create new ones
    Dim job As cJobject, co As Collection, manifest As cJobject, workJob As cJobject, _
        joc As cJobject, venueJob As cJobject, ws As Worksheet, jor As cJobject
    Set co = New Collection
    btcCreateWorkBook = False
    Set manifest = getManifest()
    
    
    'delete all potential existing sheets
    For Each job In manifest.child("setup.types").children
        Set co = findSheetsStartingWith(job.child("type").toString & "_", co)
    Next job
    
    If co.count > 0 Then
        If check Then
            If MsgBox("need to delete " & co.count & " existing worksheets", vbYesNo) <> vbYes Then
                manifest.tearDown
                Exit Function
            End If
        End If
        deleteSheetsInCollection co
    End If


    'now create new ones
    For Each job In manifest.child("setup.types").children
    
        'find the worklist for this type
        For Each workJob In manifest.child("work").children
            If workJob.toString("type") = job.toString("type") Then
                For Each venueJob In workJob.child("venues").children
                    ' create a new sheet
                    With Sheets.add(, Sheets(Sheets.count))
                        .name = workJob.toString("type") & "_" & venueJob.toString
                        ' prettify
                        With .Cells(1, 1)
                            colorizeCell .Resize(, job.child("options.columns").children.count), _
                                                job.toString("options.fillColor")
                            
                            ' add the columns for this type
                            For Each joc In job.child("options.columns").children
                                .Offset(, joc.childIndex - 1).value = joc.value
                            Next joc
                        End With
                    End With
                Next venueJob
            End If
        Next workJob
    Next job
    
    manifest.tearDown
    Set co = Nothing

End Function
Private Function findSheetsStartingWith(Optional s As String = vbNullString, Optional co As Collection = Nothing) As Collection
     Dim ws As Worksheet

     If co Is Nothing Then Set co = New Collection
     
     For Each ws In Sheets
        If (s = vbNullString Or left(ws.name, Len(s)) = s) Then
            co.add ws
        End If
     Next ws

     Set findSheetsStartingWith = co
End Function

Private Sub deleteSheetsInCollection(co As Collection)
     Dim ws As Worksheet
     ' dont want to have to confirm deletions for every sheet
     Application.DisplayAlerts = False
     
     
     For Each ws In co
        ws.Delete
     Next ws
    
     Application.DisplayAlerts = True
End Sub
Private Function findInChildren(children As cJobject, child As String, what As String) As cJobject
    Dim job As cJobject
    
    For Each job In children.children
        If LCase(job.toString(child)) = LCase(what) Then
            Set findInChildren = job
            Exit Function
        End If
    Next job
    
End Function
Private Function getSheetOrCreate(name As String, after As Worksheet) As Worksheet
    Dim ws As Worksheet
    Set ws = sheetExists(name, False)
    If ws Is Nothing Then
        Set ws = Sheets.add(, after)
        ws.name = name
    End If
    Set getSheetOrCreate = ws
    
End Function