VBA to return only unique values from a range of comma separated words on multiple rows.

[Ananthak275]

Hi everyone,

I have the following rows of texts. My data starts on Row 2 (since there is a header). how do i get the unique values? and them pasted below the last row of that column. For example, CityName (Column A) starts in A2 and ends in A7, so i want the unique values to be pasted start on A8. While StateName starts in B2 and ends in B5, so i would want the unique states starting in b6?

1	CityName	StateName
2	Dallas. Houston, Philadelphia	California, Texas
3	Chicago	Pennsylvania, California, Texas
4	Dallas. Houston, Philadelphia	Arizona, New York
5	Houston, Philadelphia, Austin	New York
6	Austin, New York City, Los Angeles
7	San Jose
8

 

[Fluff]

How about

Sub Ananthak()
   Dim Cl As Range
   Dim Ele As Variant
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         For Each Ele In Split(Cl.Value, ",")
            .Item(Trim(Ele)) = Empty
         Next Ele
      Next Cl
      Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub

And the same for col B, just change the ranges

 

[Ananthak275]

How about

Sub Ananthak()
   Dim Cl As Range
   Dim Ele As Variant
  
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         For Each Ele In Split(Cl.Value, ",")
            .Item(Trim(Ele)) = Empty
         Next Ele
      Next Cl
      Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub

And the same for col B, just change the ranges

Worked perfectly, thanks! is there a way to make the range unique? so it does this for all the columns that contain values?

 

[Fluff]

The range is unique, it's only looking at col A

 

[Ananthak275]

The range is unique, it's only looking at col A

Sorry I meant dynamic. Instead of selecting col A, b, c, etc every time, is it possible to make it all the run the code on all the columns that contain value?

 

[Fluff]

How about

Sub Ananthak()
   Dim Cl As Range, Col As Range
   Dim Ele As Variant
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Col In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
         For Each Cl In Range(Col.Offset(1), Col.Offset(Rows.Count - 1).End(xlUp))
            For Each Ele In Split(Cl.Value, ",")
               .Item(Trim(Ele)) = Empty
            Next Ele
         Next Cl
         Col.Offset(Rows.Count - 1).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
         .removeall
      Next Col
   End With
End Sub

 

[Ananthak275]

perfect!

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Ananthak275]

Fluff sorry i just realized one thing. If you re-run the code, it keeps duplicating the split values. Is there a way to only duplicate the values that dont exist?

 

[Fluff]

Not really, because there is no way of knowing which values to add.