Arrays/Collections/Unique values, oh my

[Jer Maine]

Hi, I'm attempting to copy one specific column (containing string values) from a table and then narrow them down to unique values only and get rid of blanks. I've scoured the internet and am still not sure of a good way to handle this. I have found where I can easily copy an entire table into an array, but I just want one column for now. My ultimate plan is to use those unique values to roll up dollar values in another column in the same table. Basically very similar to what a pivot table would do. But I need to add some more functionality later, so a pivot table won't do. Thanks!

 

[Fluff]

You can use a dictionary for that like

Sub CompareData()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         If Not .exists(Cl.Value) And Len(Cl) > 0 Then .Add Cl.Value, Nothing
      Next Cl
   End With
End Sub

 

[Rick Rothstein]

Hi, I'm attempting to copy one specific column (containing string values) from a table and then narrow them down to unique values only and get rid of blanks. I've scoured the internet and am still not sure of a good way to handle this. I have found where I can easily copy an entire table into an array, but I just want one column for now. My ultimate plan is to use those unique values to roll up dollar values in another column in the same table. Basically very similar to what a pivot table would do. But I need to add some more functionality later, so a pivot table won't do. Thanks!

It is not clear to me where you want the unique, non-blank values to go, so I put them in Column Z. I assumed you are running the macro with the worksheet containing the Excel Table object as the active sheet (change to a specific sheet reference if you want) and since you did not tell us which column within the Excel Table object, I assume the Table's column head text to be "Header Column Name" (change to your actual head name)...

[table="width: 500"]
[tr]
	[td]Sub UniqueValues()
  Dim R As Long, Data As Variant, Uniques As Variant
  Data = [B][COLOR="#FF0000"]ActiveSheet[/COLOR][/B].ListObjects("Table1").ListColumns("[B][COLOR="#FF0000"]Header Column Name[/COLOR][/B]").DataBodyRange
  ReDim Uniques(1 To UBound(Data), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For R = 1 To UBound(Data)
      If Len(Data(R, 1)) Then .Item(Data(R, 1)) = 1
    Next
    [B][COLOR="#FF0000"]ActiveSheet[/COLOR][/B].Range("Z1").Resize(.Count) = Application.Transpose(.Keys)
  End With
End Sub[/td]
[/tr]
[/table]

 

[Jer Maine]

Thank you, I'm going to give this a try. I don't know what the CreateObject("Scripting.Dictionary") part is all about and the Transpose with the .Keys.

 

[Fluff]

For more info on Dictionaries have a look here

 

[Jer Maine]

Thank you both. I feel like my horizons just got broadened. Is there a way to put that unique set into a new array if needed?

 

[Fluff]

Glad we could help & thanks for the feedback

 

[Rick Rothstein]

Is there a way to put that unique set into a new array if needed?

For the code I posted in Message #3 , declare your array variable (I'll give it the name Arr for example purposes) as Variant and then make this assignment immediately before the End..With statement...

Arr = .Keys

Arr will be a one-dimensional array whose first element number will be 0 (zero).