Convert an Excel table from one structure to the other

Question

Original table

I have this table in Excel or LibreOffice.

Unit number	Type	Name
1	Object	Top
1	Object	Bottom
1	Object	Left
1	Object	Right
1	Object	Back
1	Object	Front
1	Property	Right-Fixed
1	Property	Left-Fixed
1	Property	4-legs

New table

I want to convert this table to a new one. I want to keep only the rows with the Type equal to Object and apply the Properties as new columns. Like below.

Unit number	Type	Name	Right-fixed	Left-fixed	4-legs
1	Object	Top
1	Object	Bottom			True
1	Object	Left		True
1	Object	Right	True
1	Object	Back
1	Object	Front

Question

How can I do that in Excel or LibreOffice? My options are:

• Formula-based approaches.
  • Will it get too complex?
• VBA macro programming.
  • Is it overkill for this problem?

I'd appreciate any hint or help.

Note

Above, I have shown just the Unit number of 1 as a sample. But unit numbers could continue, like 2, 3, and more.

Answer 1

• Add a mapping table define the relationship between objects and properties
• The sequence of object names for each unit may different.

Option Explicit
Sub Demo()
    Dim arrData, rngData As Range
    Dim arrRes, iR As Long, i As Long
    Dim LastRow As Long, sHeader As String
    Dim dataSht As Worksheet, mapSht As Worksheet
    Dim oDicMap As Object, oDicCol As Object
    Dim oDicRow As Object, oDic As Object, sKey
    Const BASE_COLS = 3 ' The first 3 cols on output table are fixed
    Set dataSht = Sheets("Sheet1") ' modify as needed
    Set mapSht = Sheets("Sheet2")
    ' Load mapping table
    Set oDicMap = CreateObject("scripting.dictionary")
    arrData = mapSht.Range("A1").CurrentRegion.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        oDicMap(arrData(i, 1)) = arrData(i, 2)
    Next i
    ' Load source data
    Set oDicCol = CreateObject("scripting.dictionary")
    arrData = dataSht.Range("A1").CurrentRegion.Value
    iR = BASE_COLS
    ' Get header names of output
    For i = LBound(arrData) + 1 To UBound(arrData)
        If arrData(i, 2) = "Property" Then
            iR = iR + 1
            oDicCol(arrData(i, 3)) = iR
        End If
    Next i
    Set oDic = CreateObject("scripting.dictionary")
    Set oDicRow = CreateObject("scripting.dictionary")
    ' Output table header
    ReDim arrRes(1 To UBound(arrData), 1 To iR)
    arrRes(1, 1) = "Unit"
    arrRes(1, 2) = "Type"
    arrRes(1, 3) = "Name"
    For Each sKey In oDicCol.Keys
        arrRes(1, oDicCol(sKey)) = sKey
    Next
    iR = 1
    ' Loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        ' Add a new row for Object
        If arrData(i, 2) = "Object" Then
            iR = iR + 1
            arrRes(iR, 1) = arrData(i, 1)
            arrRes(iR, 2) = arrData(i, 2)
            arrRes(iR, 3) = arrData(i, 3)
            sKey = arrData(i, 1) & arrData(i, 3)
            oDicRow(sKey) = iR
        ElseIf arrData(i, 2) = "Property" Then
            ' Insert True
            If oDicMap.exists(arrData(i, 3)) And oDicCol.exists(arrData(i, 3)) Then
                sKey = arrData(i, 1) & oDicMap(arrData(i, 3))
                If oDicRow.exists(sKey) Then
                    arrRes(oDicRow(sKey), oDicCol(arrData(i, 3))) = True
                End If
            End If
        End If
    Next i
    ' Write ouput to sheet
    Sheets.Add
    Range("A1").Resize(iR, UBound(arrRes, 2)).Value = arrRes
    ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub