Home » excel » excel – How can I move VBA-JSON output to specific cells in worksheet?

excel – How can I move VBA-JSON output to specific cells in worksheet?

Posted by: admin April 23, 2020 Leave a comment

Questions:

Very new to VBA. Trying to learn as much as I can. I can get the output that I want in the immediate window, but how can I move all of that to my worksheet?

I’m honestly not sure what to try or where to try it.

Option Explicit

Sub JsonMain()
    Dim dict
    Dim subDict
    Dim strLine As String

    ' Read from file
    Dim FilePath As String
    FilePath = ThisWorkbook.Path + "\" + "Main.json"

    Dim nFile As Integer
    Dim strJson As String
    nFile = FreeFile
    Open FilePath For Input As #nFile
    strJson = Input(LOF(nFile), nFile)
    Close #nFile

    Dim jp As Scripting.Dictionary
    Set jp = JsonConverter.ParseJson(strJson)

    Dim gameData As Scripting.Dictionary
    Set gameData = jp("data")

    Dim theseMonsters As Object
    Set theseMonsters = gameData("monsters")

    Debug.Print "there are " & theseMonsters.Count & " monsters in the profile"

    Dim i As Long
    Dim monster As Dictionary
    Dim monsterName As Variant
    Dim monsterDetails As Variant
    For Each monsterName In theseMonsters.Keys
        Debug.Print "Monster #" & monsterName
        Set monsterDetails = theseMonsters(monsterName)
        Debug.Print " --               name: " & monsterDetails("class_name")
        Debug.Print " --        total level: " & monsterDetails("total_level")
        Debug.Print " --         perfection: " & monsterDetails("perfect_rate")
        Debug.Print " --       catch number: " & monsterDetails("create_index")
        Dim battleStats As Collection
        Set battleStats = monsterDetails("total_battle_stats")
        Debug.Print " -- battle stats: ";
        For i = 1 To battleStats.Count
            Debug.Print battleStats.Item(i) & " ";
        Next i
        Debug.Print ""
        ' ...
    Next monsterName
End Sub

Edit 1:

Expected results would be bold titles for each category that are printed in row A, with data going down in columns under those titles.

Here is an example output that I get in the immediate window:

Monster #47103
— name: Monstratos
— total level: 20
— perfection: 53.763
— catch number: 39
— battle stats: 218 288 221 198 227 201

I would like Row A to contain these bold headers: Monster #, Name, Total Level, Perfection, Catch Number, HP, PA, PD, SA, SD, SPD (Battle Stats is not a header, but the individual battle stats are).

Below that, for this mon as an example, would be: 47103, Monstratos, 20, 53.763, 39, 218, 288, 221, 198, 227, 201.

How to&Answers:

I think you want something like the following. You incremement the row counter, r, each time you hit a new monster dictionary. For each item of interest within the monster dictionary the column increases by 1.

Option Explicit  
Public Sub WriteOutBattleInfo()
    Dim headers(), r As Long, i As Long, json As Object, key As Variant, ws As Worksheet, battleStats As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("Monster #", "Name", "Total Level", "Perfection", "Catch Number", "HP", "PA", "PD", "SA", "SD", "SPD")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.etheremon.com/api/user/get_my_monster?trainer_address=0x2Fef65e4D69a38bf0dd074079f367CDF176eC0De", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)("data")("monsters") 'dictionary of dictionaries
    End With
    r = 2
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    For Each key In json.keys
        With ws
            .Cells(r, 1) = key
            .Cells(r, 2) = json(key)("class_name")
            .Cells(r, 3) = json(key)("total_level")
            .Cells(r, 4) = json(key)("perfect_rate")
            .Cells(r, 5) = json(key)("create_index")
            Set battleStats = json(key)("total_battle_stats")

            For i = 1 To battleStats.Count
                .Cells(r, i + 5) = battleStats.item(i)
            Next i
        End With
        r = r + 1
    Next
End Sub