Create custom columns in excel

New Contributor

I have an excel file with a column that says customfields.

Data in this column are for multiple fields. I want to create a column for the each custom value in the excel file.

Data in the custom column are between { and } brackets.

{ "Gender": "Female", "Site:": "Site1", "Department:": "FIN", "DOB:": "01/01/1970", "Last Name:": "cust1", "First Name:": "sam"}

I want to create a column for Gender, Site, Department, DOB, Last Name, First Name

Also the data for each column should be populated too



If I have the following data (3 rows)

01/01/2021,Staff1 ,{ "Gender": "Female", "Site:": "Site1", "Department:": "FIN", "DOB:": "01/01/1970", "Last Name:": "cust1", "First Name:": "sam"}

11/01/2021,Staff2 ,{ "Gender": "Male", "Site:": "Site2", "Department:": "HR", "DOB:": "01/15/1985", "Last Name:": "cust2", "First Name:": "Greg"}

07/14/2021,Staff3 ,{ "Gender": "Female", "Site:": "Site3", "Department:": "HR", "DOB:": "11/23/2005", "Last Name:": "cust3", "First Name:": "Peter"}


I am looking the following result:

01/01/2021,Staff1 ,Female,Site1,FIN,01/01/1970,cust1,sam
11/01/2021,Staff2 ,Male,Site2,HR,01/15/1985,cust2,Greg
07/14/2021,Staff3 ,Female,Site3,HR,11/23/2005,cust3,Peter


Would like to know whether this is possible.

2 Replies


Here is a macro you can run:


Sub SplitData()
    Const c1 = 3 ' Custom column = C
    Dim r As Long
    Dim m As Long
    Dim a() As String
    Dim i As Long
    Dim v() As String
    Application.ScreenUpdating = False
    m = Cells(Rows.Count, c1).End(xlUp).Row
    With Range(Cells(2, c1), Cells(m, c1))
        .Replace What:="{", Replacement:="""", LookAt:=xlPart
        .Replace What:="}", Replacement:="""", LookAt:=xlPart
        .Replace What:=":""", Replacement:="""", LookAt:=xlPart
    End With
    For r = 2 To m
        a = Split(Cells(r, c1).Value, ",")
        If r = 2 Then
            Cells(1, c1 + 1).Resize(1, UBound(a)).EntireColumn.Insert
        End If
        For i = 0 To UBound(a)
            v = Split(Trim(a(i)), ":")
            If r = 2 Then
                Cells(1, c1 + i).Value = Trim(Replace(v(0), """", ""))
            End If
            Cells(r, c1 + i).Value = Trim(Replace(v(1), """", ""))
        Next i
    Next r
    Application.ScreenUpdating = True
End Sub


As variant that could be done with Power Query


If source texts (in this case B2:B4) name as Range, script will be

    Source = Excel.CurrentWorkbook(){[Name="Range"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(
        Splitter.SplitTextByEachDelimiter({",",","}, QuoteStyle.None, false),
        {"Date", "Staff", "JSON"}
    trimColon = Table.ReplaceValue(
        #"Split Column by Delimiter",
    #"Parsed JSON" = Table.TransformColumns(
        {{"JSON", Json.Document}}
    columnNames = Record.FieldNames(#"Parsed JSON"[JSON]{0}),
    #"Expanded JSON" = Table.ExpandRecordColumn(
        #"Parsed JSON",
        "JSON", columnNames, columnNames
    #"Changed Type with Locale" = Table.TransformColumnTypes(
        #"Expanded JSON",
        {{"Date", type date}, {"DOB", type date}},
    #"Changed Type with Locale"