List unique values then combine in one single cell all data using a macro in an excel report
In one of my reports, I have to list from a column the unique values then once done, I need to extract from another column all values into one single cell corresponding to each unique value.
When I use the macro ?
To create a list of unique data then extract all data from another column.
How to create the macro ?
Read How to create, edit, hide and select a macro in an excel report
How to create the button to associate it with the macro ?
Read How to create a button and associated it to a macro in an excel report
How is/are the macro(s) ?
Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.
Sub test() ' change H2:I14 by your range to clear unique list and extracted value Range("H2:I14").ClearContents Dim x As Range With CreateObject("scripting.dictionary") .CompareMode = 1 ' change F2 and F by the column cell where to identity unique list For Each x In Range("F2", Range("F" & Rows.Count).End(xlUp)) If Not x.Value = "" Then .Item(x.Value) = Empty Next x ' change H2 by the column cell where to put the unique list Range("H2").Resize(.Count, 1).Value = Application.Transpose(Array(.Keys, .Items)) End With With ActiveSheet ' change H2 and $F$2:$F$14 by your new cells ' change I2 by the column cell where to put this formula to extract value If .Range("H2").Value > 0 Then _ .Range("I2").Value = "=IF(H2="""","""",ExtractValue($F$2:$F$14,H2))" End With ' optional line below, sort number by high to small, if want contrary, change xlDescending by xlAscending ' change H2 and H14 by your range Range("H2:H14").Sort Key1:=Range("H2"), Order1:=xlDescending ' change I2 and I3:I14 by the range to copy/paste the formula Range("I2").Copy Range("I3:I14") End Sub ' to create the formula to extract value, not needed if use TEXTJOIN formula Function ExtractValue(r As Range, v As Variant) Dim c As Range ExtractValue = "" For Each c In r If c.Value = v Then If ExtractValue = "" Then ' change -5 counting from the identified unique list column to the extract value column ' i.e. my identified unique list column F and the extract value column A = -5 ExtractValue = c.Offset(0, -5).Value Else ExtractValue = ExtractValue & " " & c.Offset(0, -5).Value End If End If Next c End Function
Interesting Topics
-
Be successfully certified ITIL 4 Managing Professional
Study, study and study, I couldn’t be successfully certified without studying it, if you are interested...
-
Be successfully certified ITIL 4 Strategic Leader
With my ITIL 4 Managing Professional certification (ITIL MP) in the pocket, it was time to go for the...
-
Hide visual and change background color based on selection
Some small tricks to customize the background colour of a text box...
-
Stacked and clustered column chart or double stacked column chart
In excel, I use a lot the combination of clustered and stacked chart...