0

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?

Nixen85
  • 1,253
  • 8
  • 24
  • I suspect the downvotes are due to the lack of clarity in the question. Is this a single cell with this value entered as an array? You want to treat this value as an array, but which value do you want to extract, or do you want to be able to flexibly specify the index of the value? (etc.) – NeepNeepNeep Dec 05 '18 at 11:51
  • Okay, i tried to sharpen my question. The array value stands in cell A1 as a string. 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. – Nixen85 Dec 05 '18 at 11:57
  • For this specific use-case, you could cobble something together by repeated use of `Mid` (to remove brackets) and `Split` (on either `","` or `":"`), but it might be preferable to find a VBA JSON parser (of which there are several), since that is a difficult wheel to reinvent properly. I haven't used it, but I have seen [this tool](https://github.com/VBA-tools/VBA-JSON) recommended on Stack Overflow. – John Coleman Dec 05 '18 at 12:07

3 Answers3

3

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.

Rik Sportel
  • 2,661
  • 1
  • 14
  • 24
  • This worked like a charme and the direct access to the object seems a robust solution to get the information. Thanks. However, I asked for VBA and in this case QHarr's Answer is correct – Nixen85 Dec 05 '18 at 20:47
2

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
QHarr
  • 83,427
  • 12
  • 54
  • 101
1

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
Harassed Dad
  • 4,669
  • 1
  • 10
  • 12