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