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?
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.
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
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
Mid(to remove brackets) andSplit(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 recommended on Stack Overflow.