Unique Values VBA

[JCAAA89]

Hello All,

Fairly new to vba and seeking a bit of help. I have this code that generates cell values in to a group with commas, but what i also need it to do is to remove all the duplicate values as well. Not sure is I can use the RemoveDuplicates method or if there's an easier way. Thanks for any help in advance!


Function CreatePhrase(NamesRng As Range) As String
'Creates a comma-separated phrase given a list of words or names

Dim Cell As Range
Dim l As Long
Dim cp As String
Cell.RemoveDuplicates Columns:=1

'Add commas between the values in the cells
For Each Cell In NamesRng
If Not IsEmpty(Cell) And Not Cell.Value = "" And Not Cell.Value = " " Then
cp = cp & Cell.Value & ", "
End If
Next Cell

'Remove trailing comma and space
If Right(cp, 2) = ", " Then cp = Left(cp, Len(cp) - 2)

'If there is only one value (no commas) then quit here
If InStr(1, cp, ",", vbTextCompare) = 0 Then
CreatePhrase = cp
Exit Function
End If

'Add "and" to the end of the phrase
For l = 1 To Len(cp)
If Mid(cp, Len(cp) - l + 1, 1) = "," Then
cp = Left(cp, Len(cp) - l + 2) & "AND" & Right(cp, l - 1)
Exit For
End If
Next l

'If there are only two words or names (only one comma) then remove the comma
If InStr(InStr(1, cp, ",", vbTextCompare) + 1, cp, ",", vbTextCompare) = 0 Then
cp = Left(cp, InStr(1, cp, ",", vbTextCompare) - 1) & Right(cp, Len(cp) - InStr(1, cp, ",", vbTextCompare))
End If

CreatePhrase = cp
End Function

 

[JackDanIce]

Welcome to the board.

Try:

Public Function CreatePhrase(ByRef rng As Range) As String

    Dim r       As Range
    Dim x       As Long
    Dim s       As String
    Dim dic     As Object
        
    Set dic = CreateObject("Scripting.Dictionary")
    
    For Each r In rng
        If Len(Trim$(r.Value)) > 0 Then dic(r.Value) = r.Value
    Next r
    
    For x = 0 To dic.count - 1
        s = s & dic.keys()(x) & ", "
    Next x
    
    s = Trim$(s)
    CreatePhrase = Trim$(Left$(s, Len(s) - 1))
    
    If Len(s) - Len(Replace(s, ",", "")) > 1 Then
        x = InStrRev(s, " ")
        CreatePhrase = Left$(s, x - 2) & " AND " & Mid$(s, x + 1, Len(s) - x - 1)
    End If
    
    Set dic = Nothing
    
End Function

 

[JCAAA89]

Just what I needed, thank you very much!!

 

[JackDanIce]

You're welcome