How to Convert Vertical List into Table

Alex20850

Board Regular
Joined
Mar 9, 2010
Messages
146
Office Version
  1. 365
Platform
  1. Windows
I have Before data where the fields go down the rows,
I want to change it into a table where each row is a different PC-Code and the columns are different fields for the PC.

Desired Format
Item00. Model00. Price01. CPU02. Cores03. TIM
BHP-01Acer 15.6" Aspire 5 Series Laptop$579.001.648
BHP-02Acer 17.3" Predator Helios 300$1,099.002.2216
BHP-04ASUS 13.3" ZenBook 13 UX331FAL$829.001.848

<colgroup><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Original Format
PC CodeFieldsValues
BHP-0100. ModelAcer 15.6" Aspire 5 Series Laptop
BHP-0100. Price$579.00
BHP-0101. CPU1.6
BHP-0102. Cores4
BHP-0103. TIM8
BHP-0104. GPU2
BHP-0105. Screen Size15.6
BHP-0106. Screen Res1920x1080
BHP-0107. Disk Size256
BHP-0108. Disk TypeSSD
BHP-0109. Pounds4.41

<colgroup><col><col><col></colgroup><tbody>
</tbody>

<colgroup><col><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Two possible solutions.

Power Query:
Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"PC Code", type text}, {"Fields", type text}, {"Values", type any}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"PC Code"}, {{"Count", each _, type table}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.Column([Count],"Values")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Custom", each Text.Combine(List.Transform(_, Text.From), ":"), type text}),
    #"Added Custom1" = Table.AddColumn(#"Extracted Values", "Custom.1", each Table.Column([Count],"Fields")),
    #"Reordered Columns" = Table.ReorderColumns(#"Added Custom1",{"PC Code", "Count", "Custom.1", "Custom"}),
    #"Removed Columns" = Table.RemoveColumns(#"Reordered Columns",{"Count", "Custom.1"}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Removed Columns", "Custom", Splitter.SplitTextByDelimiter(":", QuoteStyle.None), {"Custom.1", "Custom.2", "Custom.3", "Custom.4", "Custom.5", "Custom.6", "Custom.7", "Custom.8", "Custom.9", "Custom.10", "Custom.11"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Custom.1", type text}, {"Custom.2", type text}}),
    #"Renamed Columns" = Table.RenameColumns(#"Changed Type1",{{"Custom.1", "Model"}, {"Custom.2", "Price"}}),
    #"Changed Type2" = Table.TransformColumnTypes(#"Renamed Columns",{{"Price", Currency.Type}}),
    #"Renamed Columns1" = Table.RenameColumns(#"Changed Type2",{{"Custom.3", "CPU"}, {"Custom.4", "Cores"}, {"Custom.5", "TIM"}, {"Custom.6", "GPU"}, {"Custom.7", "Screen Size"}, {"Custom.8", "Screen Res"}, {"Custom.9", "Disk Size"}, {"Custom.10", "Disk Type"}, {"Custom.11", "Pounds"}})
in
    #"Renamed Columns1"

or VBA:

Subroutine
Code:
Sub Main()
Dim AR() As Variant: AR = Sheets("Sheet2").Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).value
Dim Obs As Object: Set Obs = CreateObject("System.Collections.ArrayList")
Dim Cols As Object: Set Cols = CreateObject("System.Collections.ArrayList")
Dim Code As String
Dim PC As New PC


Cols.Add "PC Code"


For i = LBound(AR) To UBound(AR)
    If Not Cols.contains(AR(i, 2)) Then Cols.Add AR(i, 2)
    If AR(i, 1) = Code Then
        Code = AR(i, 1)
    Else
        If Code <> vbNullString Then Obs.Add PC
        Code = AR(i, 1)
        Set PC = New PC
        PC.PC = AR(i, 1)
        PC.Model = AR(i, 3)
    End If
    
    Select Case AR(i, 2)
        Case "00. Model"
            PC.Model = AR(i, 3)
        Case "00. Price"
            PC.Price = AR(i, 3)
        Case "01. CPU"
            PC.CPU = AR(i, 3)
        Case "02. Cores"
            PC.Cores = AR(i, 3)
        Case "03. TIM"
            PC.TIM = AR(i, 3)
        Case "04. GPU"
            PC.GPU = AR(i, 3)
        Case "05. Screen Size"
            PC.Screen = AR(i, 3)
        Case "06. Screen Res"
            PC.Res = AR(i, 3)
        Case "07. Disk Size"
            PC.Disk = AR(i, 3)
        Case "08. Disk Type"
            PC.dType = AR(i, 3)
        Case "09. Pounds"
            PC.Pounds = AR(i, 3)
    End Select
Next i


Obs.Add PC


Range("F1").Resize(1, Cols.Count) = Cols.toArray


For Each p In Obs
    Dim LR As Long: LR = Range("F" & Rows.Count).End(xlUp).Row + 1
    Cells(LR, 6).value = p.PC
    Cells(LR, 7).value = p.Model
    Cells(LR, 8).value = p.Price
    Cells(LR, 9).value = p.CPU
    Cells(LR, 10).value = p.Cores
    Cells(LR, 11).value = p.TIM
    Cells(LR, 12).value = p.GPU
    Cells(LR, 13).value = p.Screen
    Cells(LR, 14).value = p.Res
    Cells(LR, 15).value = p.Disk
    Cells(LR, 16).value = p.dType
    Cells(LR, 17).value = p.Pounds
Next p


End Sub


Class Code:

Code:
Private iPC As String
Private iModel As String
Private iPrice As Currency
Private iCPU As Currency
Private iCores As Integer
Private iTIM As Integer
Private iGPU As Integer
Private iScreen As Single
Private iRes As String
Private iDisk As Integer
Private iType As String
Private iPounds As Single


Public Property Get PC()
PC = iPC
End Property


Public Property Let PC(value)
iPC = value
End Property


Public Property Get Model()
Model = iModel
End Property


Public Property Let Model(value)
iModel = value
End Property


Public Property Get Price()
Price = iPrice
End Property


Public Property Let Price(value)
iPrice = value
End Property


Public Property Get CPU()
CPU = iCPU
End Property


Public Property Let CPU(value)
iCPU = value
End Property


Public Property Get Cores()
Cores = iCores
End Property


Public Property Let Cores(value)
iCores = value
End Property


Public Property Get TIM()
TIM = iTIM
End Property


Public Property Let TIM(value)
iTIM = value
End Property


Public Property Get GPU()
GPU = iGPU
End Property


Public Property Let GPU(value)
iGPU = value
End Property


Public Property Get Screen()
Screen = iScreen
End Property


Public Property Let Screen(value)
iScreen = value
End Property


Public Property Get Res()
Res = iRes
End Property


Public Property Let Res(value)
iRes = value
End Property


Public Property Get Disk()
Disk = iDisk
End Property


Public Property Let Disk(value)
iDisk = value
End Property


Public Property Get dType()
dType = iType
End Property


Public Property Let dType(value)
iType = value
End Property


Public Property Get Pounds()
Pounds = iPounds
End Property


Public Property Let Pounds(value)
iPounds = value
End Property

I named the class PC, so you will need to do the same. With the class code open, go to the class properties and give the "(Name)" value "PC".
 
Upvote 0
Updated PQ solution

Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Pivoted Column" = Table.Pivot(Source, List.Distinct(Source[Fields]), "Fields", "Values")
in
    #"Pivoted Column"
 
Upvote 0
Thank you very much for the code. In a very interesting twist, I stumbled on a imaginative solution for my problem on YouTube last night.

https://www.youtube.com/watch?v=rscXNUlRsH0

[h=1]<yt-formatted-string force-default-style="" class="style-scope ytd-video-primary-info-renderer">Quick Excel Trick to Unstack Data from one Column to Multiple Columns</yt-formatted-string>[/h]
Once again, thanks for the code.
 
Upvote 0
Interesting trick. The good thing about using PowerQuery is that it is truly dynamic, and you don't have to worry about hiding zeroes or stretching the formulas way down to make sure you accommodate new entries. And, if you look at the updated PowerQuery solution, I posted, I think her 'this is the easiest way' argument is kind of blown. In PQ, you load the table and pivot 1 column and you're done. Her way there are formulas and initials and search and replace and custom formatting and... you get the idea. I will give her that her way is much simpler than the VBA solution.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,651
Messages
6,120,739
Members
448,989
Latest member
mariah3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top