Convert Raw Data into Tabular

[mtahreemalam]

I have an excel data file which has raw data in it. I want to convert that raw data into tabular form as shown in the sample data file attached.

Book2.xlsx

drive.google.com

Sample Data File
@Akuini @DanteAmor

 

[pbornemeier]

The sample provided does not provide enough info to completely finish a converter, and in any case it may not even work properly even with more info. Your data looks like it was in JSON format. I suggest you use the code from: VBA-tools/VBA-JSON against your original data set to see if that will do what you want.

Here is some code, but it does not handle the Interests/Additional interests as well as it should:

Option Explicit

Sub CreateTabularData()

    'Errors may occur if any inputs contain a comma

    Dim lLastRow As Long
    Dim oIDFound As Object
    Dim lOutputStartRow As Long
    Dim lWriteRow As Long
    Dim lRowIndex As Long
    Dim sText As String

    lOutputStartRow = 3
    With ActiveSheet
        .Cells(lOutputStartRow, 3).Resize(1, 8).Value = _
            Array("ID", "Name", "Audience Size", "Interests", _
            "Additional Interest", "Type", "Description", "Topic")
        lWriteRow = lOutputStartRow
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("C:J").NumberFormat = "@"
        For lRowIndex = 2 To lLastRow
            sText = .Cells(lRowIndex, 1).Text
            If InStr(sText, "id:") > 0 Then
                lWriteRow = lWriteRow + 1
                .Cells(lWriteRow, 3).Value = Replace(Replace(Mid(sText, 6), Chr(34), ""), ",", "")
            ElseIf InStr(sText, "name:") > 0 Then
                .Cells(lWriteRow, 4).Value = Replace(Replace(Mid(sText, 8), Chr(34), ""), ",", "")
            ElseIf InStr(sText, "audience_size: ") > 0 Then
                .Cells(lWriteRow, 5).Value = Replace(Mid(sText, 16), ",", "")
            ElseIf InStr(sText, "Interests,") > 0 And Len(sText) = 10 Then
                If InStr(.Cells(lRowIndex + 1, 1).Text, "Additional interests,") = 0 Then
                    .Cells(lWriteRow, 6).Value = Replace(.Cells(lRowIndex + 1, 1).Text, ",", "")
                End If
            ElseIf InStr(sText, "description: ") > 0 Then
                .Cells(lWriteRow, 9).Value = Replace(Replace(Mid(sText, 14), Chr(34), ""), ",", "")
            ElseIf InStr(sText, "topic: ") > 0 Then
                .Cells(lWriteRow, 10).Value = Replace(Mid(sText, 9), Chr(34), "")
            End If
        Next
    End With
End Sub