How to group a list in excel? - excel

Question

I have a list of lists in Excel. There is some specifications (name, age, country, etc) in the first column and values in the second column. I don't want to repeat the same specifications over and over again. What I want to show in the picture. I tried =VLOOKUP() but it did not work perfectly because the lists do not include the same specifications. How can I achieve this?

Answer 1

A VBA macro can generate the results, and also the list of parameters for the first column of results.
To enter this Macro (Sub), alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.
Be sure to set the Reference as stated in the Note in the macro
To use this Macro (Sub), alt-F8 opens the macro dialog box. Select the macro by name, and RUN.
This macro generates the list with the parameter list in the first column. It could be easily rewritten to have the parameter list in the first row, if that is preferable.
Option Explicit
'Set Reference to Microsoft Scripting Runtime
Sub GroupLists()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim dictParams As Dictionary
Dim sParam As String
Dim I As Long, J As Long, K As Long
Dim V As Variant
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet1")
Set rRes = wsRes.Cells(1, 5)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
End With
'Get unique list of Parameters with row number
'Also count the number of entries for number of columns in final result
J = 0
Set dictParams = New Dictionary
K = 0 'row number for parameter
For I = 1 To UBound(vSrc, 1)
J = J + 1 'column count
Do
If Not dictParams.Exists(vSrc(I, 1)) Then
K = K + 1
dictParams.Add Key:=vSrc(I, 1), Item:=K
End If
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = ""
If I > UBound(vSrc) Then Exit For
Next I
'Create results array
ReDim vRes(1 To dictParams.Count, 1 To J + 1)
'Populate Column 1
For Each V In dictParams.Keys
vRes(dictParams(V), 1) = V
Next V
'Populate the data
J = 1 'column number
For I = 1 To UBound(vSrc, 1)
J = J + 1
Do
sParam = vSrc(I, 1)
vRes(dictParams(sParam), J) = vSrc(I, 2)
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = ""
If I > UBound(vSrc) Then Exit For
Next I
'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
rRes.EntireColumn.Clear
rRes = vRes
End Sub
EDIT: Macro modified to reflect the "real data"
Please note: You will need to add a second worksheet for the results. I named it "Sheet2"
Option Explicit
'Set Reference to Microsoft Scripting Runtime
Sub GroupLists()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim dictParams As Dictionary
Dim sParam As String
Dim I As Long, J As Long, K As Long
Dim V As Variant
Dim sDelim As String 'Differentiates each record
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet2")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
sDelim = vSrc(1, 1)
End With
'Get unique list of Parameters with row number
'Also count the number of entries for number of columns in final result
J = 0
Set dictParams = New Dictionary
K = 0 'row number for parameter
For I = 1 To UBound(vSrc, 1)
J = J + 1 'column count
Do
If Not dictParams.Exists(vSrc(I, 1)) Then
K = K + 1
dictParams.Add Key:=vSrc(I, 1), Item:=K
End If
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = sDelim
If I > UBound(vSrc) Then
Exit For
Else
I = I - 1
End If
Next I
'Create results array
ReDim vRes(1 To dictParams.Count, 1 To J + 1)
'Populate Column 1
For Each V In dictParams.Keys
vRes(dictParams(V), 1) = V
Next V
'Populate the data
J = 1 'column number
For I = 1 To UBound(vSrc, 1)
J = J + 1
Do
sParam = vSrc(I, 1)
vRes(dictParams(sParam), J) = vSrc(I, 2)
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = sDelim
If I > UBound(vSrc) Then
Exit For
Else
I = I - 1
End If
Next I
'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
rRes.EntireColumn.Clear
rRes = vRes
End Sub
EDIT2: This macro is a modification of the above, which lists the results in the opposite orientation. It may be more useful.
Option Explicit
'Set Reference to Microsoft Scripting Runtime
Sub GroupListsVertical()
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes As Variant
Dim dictParams As Dictionary
Dim sParam As String
Dim I As Long, J As Long, K As Long
Dim V As Variant
Dim sDelim As String 'Differentiates each record
Set wsSrc = Worksheets("sheet1")
Set wsRes = Worksheets("sheet3")
Set rRes = wsRes.Cells(1, 1)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
sDelim = vSrc(1, 1)
End With
'Get unique list of Parameters with row number
'Also count the number of entries for number of columns in final result
J = 0
Set dictParams = New Dictionary
K = 0 'column number for parameter
For I = 1 To UBound(vSrc, 1)
J = J + 1 'row count
Do
If Not dictParams.Exists(vSrc(I, 1)) Then
K = K + 1
dictParams.Add Key:=vSrc(I, 1), Item:=K
End If
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = sDelim
If I > UBound(vSrc) Then
Exit For
Else
I = I - 1
End If
Next I
'Create results array
ReDim vRes(1 To J + 1, 1 To dictParams.Count)
'Populate row 1
For Each V In dictParams.Keys
vRes(1, dictParams(V)) = V
Next V
'Populate the data
J = 1 'row number
For I = 1 To UBound(vSrc, 1)
J = J + 1
Do
sParam = vSrc(I, 1)
vRes(J, dictParams(sParam)) = vSrc(I, 2)
I = I + 1
If I > UBound(vSrc) Then Exit Do
Loop Until vSrc(I, 1) = sDelim
If I > UBound(vSrc) Then
Exit For
Else
I = I - 1
End If
Next I
'Write the results
Set rRes = rRes.Resize(UBound(vRes, 1), UBound(vRes, 2))
rRes.EntireColumn.Clear
rRes = vRes
rRes.EntireColumn.AutoFit
End Sub

Answer 2

Use following ARRAY formulas.
Cell F2 formula
=IFERROR(INDEX($B$1:$B$20,SMALL(IF($A$1:$A$20=$E2,ROW($B$1:$B$20),""),COLUMN(A:A))),"")
Cell E19 formula
=IFERROR(INDEX($B$1:$B$20,SMALL(IF($A$1:$A$20=$E2,ROW($B$1:$B$20),""),COLUMN(A:A))),"")
Press CTRL+SHIFT+ENTER to evaluate the formula as it is an array formula.