List Array

[Finalfight40]

Hi All

I was wondering if it would be possible to create a formula to create the list like the sample below. My desired result will be in column C and assume the data starts in A1.

A	1	1
B	2
B	3	2, 3
C	4	4
D	5
D	6
D	7	5, 6, 7

<tbody>
</tbody>

Thanks in Advance for taking the time to look.

 

[Eric W]

First, let's add a header since it makes the formula much easier. Second, the formula requires TEXTJOIN, which is currently only available in Office 365. But with those caveats, try:

	A	B	C
1	Code	Value	List
2	A	1	1
3	B	2
4	B	3	2, 3
5	C	4	4
6	D	5
7	D	6
8	D	7	5, 6, 7

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Worksheet Formulas Cell Formula C2 =IF(A2=A3,"",TEXTJOIN(", ",TRUE,INDEX(B:B,LOOKUP(2,1/(C$1:C1<>""),ROW(B$2:B2))):B2)) <thead> </thead><tbody> </tbody>

<tbody>
</tbody>

If you don't have TEXTJOIN, you'll likely need VBA.

 

[MickG]

Just in Case, VBA solution.

Sub MG11Jul38
Dim Rng As Range, Dn As Range, n As Long, k As Variant
Set Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
    .Add Dn.Value, Dn.Offset(, 1)
Else
    Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, 1))
End If
Next
For Each k In .keys
    If .Item(k).Count = 1 Then
        .Item(k).Offset(, 1).Value = .Item(k)
    Else
        .Item(k)(.Item(k).Count).Offset(, 1) = _
        Join(Application.Transpose(.Item(k).Value), ",")
    End If
Next k
End With
End Sub

Regards Mick

 

[Finalfight40]

Both of these methods work beautifully.

Thank you very much!

 

[KMVKMVKMV]

Just in Case, VBA solution.

Regards Mick

Thank you MickG.

As as newbie, I am really interested to understand how your code works in depth. Would you be so kind to describe it with comments ?

Regards,
K

 

[Rick Rothstein]

Just in Case, VBA solution.

[COLOR="Navy"]Sub[/COLOR] MG11Jul38
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
    .Add Dn.Value, Dn.Offset(, 1)
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]Set[/COLOR] .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, 1))
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] .Item(k).Count = 1 [COLOR="Navy"]Then[/COLOR]
        .Item(k).Offset(, 1).Value = .Item(k)
    [COLOR="Navy"]Else[/COLOR]
        .Item(k)(.Item(k).Count).Offset(, 1) = _
        Join(Application.Transpose(.Item(k).Value), ",")
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

For those who might be interested, here is an alternate way to write this macro...

[table="width: 500"]
[tr]
	[td]Sub ConcatCodeValues()
  Dim LR As Long, Ar As Range
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C2:C" & LR) = Evaluate("IF(A2:A" & LR & "<>A3:A" & LR + 1 & ",B2:B" & LR & ","""")")
  For Each Ar In Range("C2:C" & LR).SpecialCells(xlBlanks).Areas
    Ar(1).Offset(Ar.Count) = Join(Application.Transpose(Ar(1).Resize(Ar.Count + 1).Offset(, -1)), ", ")
  Next
End Sub[/td]
[/tr]
[/table]

 

[MickG]

FinalFight40, Your welcome

KVKMKMV, This may help !!

Private Sub CommandButton1_Click()
Dim Rng As Range, Dn As Range, n As Long, k As Variant
Set Rng = Range("A1", Range("A" & Rows.Count).End(xlUp))

With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
If Not .Exists(Dn.Value) Then
    'Unique values in column"A" added to dictionary as "Key",
    'with column "B" Range Object added as "Item"
         
          '(Key)     (item)
    .Add Dn.Value, Dn.Offset(, 1)
Else
   'Where Duplicate values of column "A" uniques are found
   ' The Column "B" range Object is added to the "Items" of Column "A" value
   ' using the "Union" function
   
    Set .Item(Dn.Value) = Union(.Item(Dn.Value), Dn.Offset(, 1))
End If
Next
'As a result of the dictioary code above, each unique value in
'column "A" has its dictionary item set to the range of cells in column "B"
'that reflect that unique column "A" "Key"

'Loop through each "Key" in dictionary
For Each k In .keys
    'Nb:- .item(k)is a range of cells, could be one , could be multi cells
   
    If .Item(k).Count = 1 Then
            'If the Number of cells in the "item) of the "Key" "K" is one,
          'Then the "Item" of the "key" "K" is set in column "C" of the Row of ".item(k)"
        
         .Item(k).Offset(, 1).Value = .Item(k)
    Else
        'If the Number of cells in the "item) of the "Key" "K" is Greater that one,
         'Then the "Items" of the "key" "K" (a multi range)is conatenated togeter using the "Join" function.
         'That value is then placed in the last row (column "C") of the range of cells in the range  ".item(k)"
         'NB:- .item(k).count, is the last row of the range ".item(k0"
        
         .Item(k)(.Item(k).Count).Offset(, 1) = _
        Join(Application.Transpose(.Item(k).Value), ",")
    End If
Next k
End With
End Sub

Regards Mick