CODEWITHSUNDEEP
jsonexcelvba
Afif abiyyuna
Afif abiyyuna

Reputation: 1

How to import JSON file to MS excel horizontally using VBA

Hello i want to ask about some problem about excel, i have some data like this:

enter image description here

and i have import that JSON data to excel with modules from https://github.com/TheEricBurnett/Excellent-JSON

and my code form are

Private Sub ImportJSONFIle_Click()
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
            .Title = "Select a JSON File"
            .AllowMultiSelect = False  
        If .Show() Then
            Filename = .SelectedItems(1)
            Dim content As String
            Dim iFile As Integer: iFile = FreeFile
            Open Filename For Input As #iFile
                content = Input(LOF(iFile), iFile)
                ' Parse JSON String
                Dim dummyData As Object
                Set dummyData = JsonConverter.ParseJson(content)
                i = 1
                For Each dummyDatas In dummyData
                    Cells(i, 1) = dummyDatas("nama")
                    Cells(i, 2) = dummyDatas("email")
                    i = i + 1
                    Next
                Close #iFile
        End If
    End With End Sub

finally the result is:

enter image description here

Here i want to ask how to make the data written horizontally not vertically? Here the result what i want :

enter image description here

Upvotes: 0

Views: 915

Answers (3)

Raymond Wu
Raymond Wu

Reputation: 3387

Since you could potentially deal with alot of entries from the JSON, it is recommended to populate the values in an array first then write into your worksheet.

Replace this:

For Each dummyDatas In dummyData
    Cells(i, 1) = dummyDatas("nama")
    Cells(i, 2) = dummyDatas("email")
    i = i + 1
Next

To this:

Dim outputArr() As Variant
ReDim outputArr(1 To 1, 1 To dummyData.Count * 2) As Variant

For Each dummyDatas In dummyData
    outputArr(1, i) = dummyDatas("nama")
    i = i + 1
    outputArr(1, i) = dummyDatas("email")
    i = i + 1
Next

Cells(1, 1).Resize(, UBound(outputArr, 2)).Value = outputArr

EDIT - To insert result after the last column

Dim outputArr() As Variant
ReDim outputArr(1 To 1, 1 To dummyData.Count * 2) As Variant

For Each dummyDatas In dummyData
    outputArr(1, i) = dummyDatas("nama")
    i = i + 1
    outputArr(1, i) = dummyDatas("email")
    i = i + 1
Next

Dim lastCol As Long
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Cells(1, lastCol + 1).Resize(, UBound(outputArr, 2)).Value = outputArr

Upvotes: 1

The KNVB
The KNVB

Reputation: 3844

You may try to replace :

  Cells(i, 1) = dummyDatas("nama")
  Cells(i, 2) = dummyDatas("email")

with

  Cells(1,i) = dummyDatas("nama")
  i=i+1
  Cells(1,i) = dummyDatas("email")

Upvotes: 1

Foxfire And Burns And Burns
Foxfire And Burns And Burns

Reputation: 11988

Not tested but this should work. Replace this:

Cells(i, 1) = dummyDatas("nama")
Cells(i, 2) = dummyDatas("email")
i = i + 1

With:

Cells(1, i) = dummyDatas("nama")
Cells(1, i+1) = dummyDatas("email")
i=i+2

Upvotes: 0

Related Questions