How to extract a value from an array in excel with VBA

Question

In my table, I have a cell A1 containing an array as string with the following format: [{'type':'general', 'name':'light'},{'type':'brand', 'name':'lighti'},{'type':'misc', 'name':'Sale%'}]

Now I want to create a new sheet, with the name of the brand "lighti" as separate cell-value. This means: I want to get the value in A1, find type "brand" and return the name of the brand and paste it to A2. That's all.

How can I extract the value of the array by using VBA?

Answer 1

You can use ActiveX ScriptControl with Language set to JScript and parse the string as actual JSON.

Then you can just write a Javascript function that returns the "name" based on the "type". For this you don't need any external libraries / other macro's etc.:

Option Explicit
Public Sub UseScriptControlAndJSON()
    Dim JsonObject As Object
    Dim resultString As String
    Dim ScriptEngine As Object

    'get the script control:
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"

    'Add javascript to get the "name" based on "typeName":
    ScriptEngine.AddCode "function findByType(jsonObj, typeName) { for (var i = 0; i < jsonObj.length; i++) { if (jsonObj[i].type == typeName){ return jsonObj[i].name; }}}"

    'Get the string and parse it:
    Set JsonObject = ScriptEngine.Eval("(" & Range("A1").Value & ")")

    'Now get the resulting "name" using the JS function, by passing in "brand" as type:
    resultString = ScriptEngine.Run("findByType", JsonObject, "brand")

    'Will pop-up: "lighti"
    MsgBox resultString
End Sub

Note 1: that the JS function will return the first occurance.

Note 2: Strictly speaking you're not using VBA to extract the value.

Note 3: Tested with 32 bit Excel 2016 on a 64 bit machine; script control is a 32 bit-component - see for example this question+answers - On 64bit you can get it to work with some workarounds as per one of the answers in that link.

Answer 2

Assumng the word brand preceeds the brand name each time then

Function GetNameOfBrand(celltext As String) As String
Dim x As Long
Dim s As String
x = InStr(celltext, "brand")
If x = 0 Then
    GetNameOfBrand = ""
Else
    s = Mid(celltext, x + 16, Len(celltext) - x + 15)
    x = InStr(s, "'")
    s = Left(s, x - 1)
    GetNameOfBrand = s
End If
End Function

Answer 3

You could use a custom function to read value from A1, apply split with search term and parse out the required info. It seems a bit overkill to use a JSON parser though that string is JSON and you could extract that way.

Option Explicit

Public Sub test()
    [A2] = GetValue([a1], "brand")
End Sub
Public Function GetValue(ByVal rng As Range, ByVal searchTerm As String) As Variant
    '[{'type':'general', 'name':'light'},{'type':'brand', 'name':'lighti'},{'type':'misc', 'name':'Sale%'}]
    On Error GoTo errhand
    GetValue = Split(Split(rng.Value, "{'type':'" & searchTerm & "', 'name':'")(1), "'")(0)
    Exit Function
errhand:
    GetValue = CVErr(xlErrNA)
End Function

---

If you were to use a JSONParser like JSONConverter.bas you could parse the JSON as follows. Note: After adding the .bas to your project you need to go VBE > Tools > References and add a reference to Microsoft Scripting Runtime.

Option Explicit
Public Sub test()
    [A2] = GetValue([a1], "brand")
End Sub
Public Function ExtractItem(ByVal rng As Range, ByVal searchTerm As String) As Variant
    Dim json As Object, key As Object
    json = JsonConverter.ParseJson(rng.Value)
    For Each item In json
        For Each key In item
            If key = searchTerm Then
                GetValue = item(key)
                Exit Function
            End If
        Next
    Next
    ExtractItem = CVErr(xlErrNA)
End Function