(Solved) – Create List of unique elements and display group membership parsed by commas and en-dash

(solved)-–-create-list-of-unique-elements-and-display-group-membership-parsed-by-commas-and-en-dash

I’m an Excel VBA newbie and I’m trying to figure out how to create a unique list of names in one column with associated group names in the next column.

For example, the Name “cds” is a member of the following groups: “group1″,”group3″,”group4b”,”group5″, and group6.
I would like the output to show:

  |Column D   | Column E                 |
     cds          group1, group3–group6

I did find a Macro on a different message board that displays the unique element with the associated Group Number(s) instead of Group Name(s). Membership in consecutive group numbers are represented by the en-dash, otherwise group numbers are separated by commas.

The sample output below shows a list of Names and the associated Group Number which I have copied and pasted from another spreadsheet. The Macro creates the output found in Column D and Column E. Given the key shown in Columns G and H, Is it possible to replace the associated group numbers in Column E with the “Group Name” found in Column H? Thanks for your help!

       |Column A | Column B | Column C | Column D       | Column E  | Column F | Column G     |   Column H        |
Row 1    NAME       GROUP #              NAME (UNIQUE)    GROUP(#s)              Group # (Key)   Group Name (Key)
Row 2    cds         1                     abc             1, 9-10                   1            group1
Row 3    cds         3                     cds             1, 3, 4-6                 2            group2a
Row 4    cds         4                     xyz             7-8                       3            group3
Row 5    cds         5                     zzz             10                        4            group4b
Row 6    cds         6                                                               5            group5
Row 7    abc         10                                                              6            group6
Row 8    abc         9                                                               7            group7
Row 9    xyz         7                                                               8           group8_1
Row 10   xyz         8                                                               9           group9_Z
Row 11   zzz         10                                                              10          group10A

Here is the associated code I used:

Sub OrganizeByNumber()

Dim a, i As Long, e, x, temp, buff

a = Range("a2").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
 For i = 2 To UBound(a, 1)
 If Not .exists(a(i, 1)) Then
 Set .Item(a(i, 1)) = _
 CreateObject("System.Collections.ArrayList")
 End If
 .Item(a(i, 1)).Add a(i, 2)
 Next
 For Each e In .keys
 .Item(e).Sort
 x = .Item(e).ToArray
 temp = x(0) & Chr(150)
 If UBound(x) > 0 Then
 For i = 1 To UBound(x)
 If x(i) - x(i - 1) = 1 Then
 buff = x(i)
 Else
 temp = temp & buff
 If temp Like "*" & Chr(150) Then temp = Left$(temp, Len(temp) - 1)
 temp = temp & ", " & x(i) & Chr(150)
 buff = ""
 End If
 Next
 If buff <> "" Then
 temp = temp & buff
 Else
 temp = Left$(temp, Len(temp) - 1)
 End If
 .Item(e) = Array(e, temp)
 Else
 .Item(e) = Array(e, Replace(temp, Chr(150), ""))
 End If
 Next
 Range("d2").Resize(.Count, 2).Value = _
 Application.Transpose(Application.Transpose(.items))
End With
End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *