Concatenate Unique Values - Minor VBA issue

[Dan5977]

Hi all,

I am having a minor issue with a function for concatenating a range into a comma seperated list. The function is as follows:

Function ConcatUniq(xRg As Range, xChar As String) As String
    Dim xCell As Range
    Dim xDic As Object
    Set xDic = CreateObject("Scripting.Dictionary")
    For Each xCell In xRg
        xDic(xCell.Value) = Empty
    Next
    ConcatUniq = Join$(xDic.Keys, xChar)
    Set xDic = Nothing
End Function

I then enter =ConcatUniq(finish,",") into the cell where I want the comma seperated list (finish is a named range).

This works really well apart from one minor issue. I am getting an extra comma after the first item in the list.
So it would say for example 'Black,,Yellow,Orange' instead of 'Black,Yellow,Orange'

As always, any help would be appreciated.

 

[steve the fish]

See if this works:

Set xDic = CreateObject("Scripting.Dictionary")
For Each xCell In xRg
    s = Trim(xCell.Value)
    If Len(s) > 0 Then xDic(s) = xDic(s) + 1
Next xCell
ConcatUniq = Join$(xDic.keys, xChar)

 

[Yongle]

see if this does what you want
- adjusted to ignore EMPTY cells

Function ConcatUniq(xRg As Range, xChar As String) As String
    Dim xCell As Range
    Dim xDic As Object
    Set xDic = CreateObject("Scripting.Dictionary")
    For Each xCell In xRg
        [COLOR=#b22222]If xCell <> "" Then xDic(xCell.Value) = Empty[/COLOR]
    Next
    ConcatUniq = Join$(xDic.Keys, xChar)
    Set xDic = Nothing
End Function

If you have Excel 365 (or possibly Excel 2019 ??) function TEXJOIN returns what you want
(test the function - it either returns #NAME? error or the correct answer! )
delimiter = ",", ignore empty cells = TRUE, Concatentate range F2:K2
=TEXTJOIN(",",TRUE,F2:K2)

 

[steve the fish]

Textjoin wont do unique used like that which i guess is required going by the function name

 

[Dan5977]

Both of those solutions work. Thank you very much

Unfortunately we are still stuck on Excel 2010! If we had Office365 I would probably have used the new UNIQUE function to create a unique list to refer to. Until then this works great thanks.