Excel - Find unique values in one column and corresponding values from another

Question

I have a database export of components and labels in two columns. Column A contains a component and column B contains the labels associated with the component. The same component can show up multiple times in column A but with a different set of labels.

I need to create a unique list of components in cell D and list every associated label in the cell next to the component in column E.

I know how to create a unique list of values in column A, but not how to separate the values if more than one appear in the same cell. I cannot change how the database exports this data.

I know enough about VBA to create a macro for this if that is the only way to do it. Any help would be appreciated.

Here is what I need to do:

Answer 1

You can do this by making a two-dimensional dictionary. I have suggested dictionary, because it takes care of uniqueness. I have written a macro that does the task (at least on your example data). It first sets up the two-dimensional data structure, then prints it out sorted alphabetically. It includes a simplified version of a sorting function I have found here: https://exceloffthegrid.com/sorting-an-array-alphabetically-with-vba/

In my macro data is read from line 1 (For i = 1 To Cells(Row.Count...) to the last line which contains data. Adjust if necessary. You may also have set the correct column letters (just search for ActiveSheet.Range and you will see).

Please note that the sort function sorts alphabetically, so label 11 will come before label 2. If that is a matter, I think the quickest way is to create a second sort function for the label array, which converts the labels to numbers before comparison. I know, I know this comes with terrible performance, but hopefully that does not matter :)

First the macro reads all input lines and splits them by , characters (removing spaces before - if components and labels are always separated by comma and space, you can simplify). For each component it creates a sub-dictionary, where the labels are stored and fills them. If a component occurs multiple times, the existing dictionary is updated. This is the first main For loop. If data is set up, it prints out the data sorted to columns D and E. This is the second main For Each loop.

Finally the code (I have it in the workbook section, not in the sheet's code module, but could work there as well):

Sub CollectLabels()
    Dim spl() As String
    Dim dict
    Dim subDict
    Dim lbl As String

    ' Collect data into a 2-dimensional dictionary
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        comps = Split(Replace(ActiveSheet.Range("A" & i).Text, " ", ""), ",")
        For Each comp In comps
            If Not dict.Exists(comp) Then
                Set subDict = CreateObject("Scripting.Dictionary")
                dict.Add comp, subDict
            End If
            Labels = Split(Replace(ActiveSheet.Range("B" & i).Text, " ", ""), ",")
            For Each Label In Labels
                dict(comp)(Label) = 1
            Next Label
        Next comp
    Next i

    i = 1
    ' Output the dictionary contents
    For Each Key In SortArray(dict.Keys)
        ActiveSheet.Range("D" & i).Value = Key
        lbl = ""
        For Each Key2 In SortArray(dict(Key).Keys)
            lbl = lbl & Key2 & ", "
        Next Key2
        ActiveSheet.Range("E" & i).Value = lbl
        i = i + 1
    Next Key
End Sub

Function SortArray(arr As Variant)

Dim i As Long
Dim j As Long
Dim Temp

For i = LBound(arr) To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
        If arr(i) > arr(j) Then
            Temp = arr(j)
            arr(j) = arr(i)
            arr(i) = Temp
        End If
    Next j
Next i

SortArray = arr

End Function