Reputation: 157
I have an Excel file with a column with rows in the following format:
{'gender': 'Male', 'national.': 'GBR', 'doc_type': 'passport', 'expiry': '2012-02-12', 'issuer': 'GBR'}
I would like to parse through the rows, say A1:A7, to extract it as a meaningful data like that, splitting it into multiple columns.
A B C D E
Gender Nat Doc_T Date of Expiry Issuer
Male GBR Passport 2012-02-12 GBR
Male GBR Passport 2012-02-12 GBR
Male GBR Passport 2012-02-12 GBR
I made a head start and wrote this code, however it piles all the data into one cell, I'm not sure how to split it further as above. Any help would be appreciated.
Sub test3()
Dim rng1 As Range
Dim c As Range
Set rng1 = Range("A1:A7")
For Each c In rng1
For Each e In Split(Replace(Replace(Replace(c, "'", ""), "{", ""), "}", ""), ",")
x = Split(e, ":")
temp = x(0): x(0) = x(1): x(1) = temp
c.Value = c.Value & vbLf & Application.Trim(Join(x, " "))
Next
Next c
Produced Ouput with my code:
Male gender
GBRnationality
passport document_type
2012-02-12 date_of_expiry
GBR issuing_country
Any help would be appreciated, thank you!
Upvotes: 0
Views: 81
Reputation: 60494
Since these entries are JSON strings, I would use a Json Parser. One that I like is by (c) Tim Hall
Then the code becomes:
Option Explicit
Sub parseJsonLine()
Dim JSON As Object
Dim ws As Worksheet, rSrc As Range, c As Range, r As Range
Dim v, J As Long, O As Object
Set ws = Worksheets("sheet2")
With ws
.Range(.Cells(1, 2), .Cells(1, 20)).EntireColumn.Clear
Set rSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
For Each c In rSrc
Set JSON = parsejson(c.Value2)
If ws.Cells(1, 2).Value2 = "" Then
v = JSON.Keys
Set r = ws.Range(ws.Cells(1, 2), ws.Cells(1, UBound(v) + 2))
r.Value2 = v
End If
J = 1
For Each v In JSON
J = J + 1
c(2, J) = JSON(v)
Next v
Next c
End Sub
And the results:
I put the results starting in Column B, but you could overwrite, or put them on a different worksheet, by changing some of the variables in the code.
Upvotes: 2
Reputation: 8531
I would suggest something along these lines:
Sub TestParseString()
Dim s As String
s = "{'gender': 'Male', 'nationality': 'GBR', 'document_type': 'passport', 'date_of_expiry': '2012-02-12', 'issuing_country': 'GBR'}"
ParseString s, Range("a1"), True
ParseString s, Range("a2")
End Sub
Sub ParseString(strInput As String, rngOutput As Range, _
Optional blnHeaders = False)
Dim s2 As String
Dim a() As String
Dim l As Long
strInput = Replace(Replace(strInput, "{", ""), "}", "")
a = Split(strInput, ",")
For l = 0 To UBound(a)
If blnHeaders Then
s2 = Trim(Replace(Split(a(l), ":")(0), "'", ""))
rngOutput.Offset(0, l).value = s2
End If
s2 = Trim(Replace(Split(a(l), ":")(1), "'", ""))
rngOutput.Offset(Abs(blnHeaders), l).value = s2
Next l
End Sub
Upvotes: 1
Reputation: 57753
{}
,
to get the data pairs into an array DataPairs
.:
.''
of the data and write it into the cells.So something like this should work:
Option Explicit
Public Sub ParseData()
Dim RawData As String
RawData = "{'gender': 'Male', 'nationality': 'GBR', 'document_type': 'passport', 'date_of_expiry': '2012-02-12', 'issuing_country': 'GBR'}"
Dim wsOutput As Worksheet
Set wsOutput = ThisWorkbook.Worksheets("Sheet1")
Dim NextFreeRow As Long
NextFreeRow = wsOutput.Cells(wsOutput.Rows.Count, "A").End(xlUp).Row + 1
'strip off {}
RawData = Mid$(RawData, 2, Len(RawData) - 2)
Dim DataPairs() As String
DataPairs = Split(RawData, ", ")
Dim iPair As Long
For iPair = LBound(DataPairs) To UBound(DataPairs)
Dim FieldData() As String
FieldData = Split(DataPairs(iPair), ": ")
wsOutput.Cells(NextFreeRow, iPair + 1).Value = Mid$(FieldData(1), 2, Len(FieldData(1)) - 2) 'strip of '' and write to cell
Next iPair
End Sub
Finally you will figure out how to get the headlines too.
Upvotes: 1