CODEWITHSUNDEEP
vbastringduplicates
Drequick
Drequick

Reputation: 11

Removing Duplicate values from a string in VBA

In VBA if I have a string of numbers lets say ("1,2,3,4,5,2,2"), how can I remove the duplicate values and only leave the first instance so the string says ("1,2,3,4,5").

Upvotes: 1

Views: 16628

Answers (5)

Lalitha
Lalitha

Reputation: 1

vb6,Find Duplicate letter in word when there is no delimiter.

Function RemoveDuplicateLetter(ByVal MyString As String) As String
Dim MyArr As Variant, MyNewArr() As String, X As String,str as String
Dim bValue As Boolean
Dim i As Long, j As Long
For i = 0 To Len(MyString)
    str = str & Mid$(MyString, i + 1, 1) & vbNullChar
Next

i = 0
MyArr = Split(str, vbNullChar)
ReDim MyNewArr(0)
MyNewArr(0) = MyArr(0)

For i = LBound(MyArr) To UBound(MyArr)
    bValue = True
    For j = i + 1 To UBound(MyArr)
        If MyArr(i) = MyArr(j) Then
            bValue = False
            Exit For
        End If
    Next
    If bValue Then X = X & " " & MyArr(i)
Next
RemoveDuplicateLetter = X
End Function

Upvotes: 0

Dan Donoghue
Dan Donoghue

Reputation: 6206

Heres my crack at it:

Function Dedupe(MyString As String, MyDelimiter As String)
    Dim MyArr As Variant, MyNewArr() As String, X As Long, Y As Long
    MyArr = Split(MyString, MyDelimiter)
    ReDim MyNewArr(0)
    MyNewArr(0) = MyArr(0)
    Y = 0
    For X = 1 To UBound(MyArr)
        If InStr(1, Join(MyNewArr, MyDelimiter), MyDelimiter & MyArr(X)) = 0 Then
            Y = Y + 1
            ReDim Preserve MyNewArr(Y)
            MyNewArr(Y) = MyArr(X)
        End If
    Next
    Dedupe = Join(MyNewArr, MyDelimiter)
End Function

Call it like this in code:

Dedupe(Range("A1").Text,",")

Or like this in the sheet:

=Dedupe(A1,",")

The first parameter is the cell to test and the second is the delimiter you want to use (in your example it is the comma)

Upvotes: 0

Vasily
Vasily

Reputation: 5782

try this:

Sub test()
    Dim S$: S = "1,2,3,4,5,2,2,5,6,6,6"
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim Key As Variant
    For Each Key In Split(S, ",")
        If Not Dic.exists(Trim(Key)) Then Dic.Add Trim(Key), Nothing
    Next Key
    S = Join(Dic.Keys, ","): MsgBox S
End Sub

Upvotes: 0

Zev Spitz
Zev Spitz

Reputation: 15327

I suggest writing a Join function to combine the unique parts back into a single string (there is one available for arrays, but not for any other collection):

Function Join(Iterable As Variant, Optional Delimiter As String = ",") As String
    Dim notFirst As Boolean
    Dim item As Variant
    For Each item In Iterable
        If notFirst Then
            Join = Join & Delimiter
        Else
            notFirst = True
        End If
        Join = Join & item
    Next
End Function

Then, use Split to split a string into an array, and Scripting.Dictionary to enforce uniqueness:

Function RemoveDuplicates(s As String, Optional delimiter As String = ",") As String
    Dim parts As String()
    parts = Split(s,delimiter)
    Dim dict As New Scripting.Dictionary
    Dim part As Variant
    For Each part In parts
        dict(part) = 1 'doesn't matter which value we're putting in here
    Next
    RemoveDuplicates = Join(dict.Keys, delimiter)
End Function

Upvotes: 0

tigeravatar
tigeravatar

Reputation: 26640

Here is a function you can use to dedupe a string as you've described. Note that this won't sort the deduped string, so if yours was something like "4,2,5,1,3,2,2" the result would be "4,2,5,1,3". You didn't specify you needed it sorted, so I didn't include that functionality. Note that the function uses , as the default delimiter if not specified, but you can specify a delimiter if you choose.

Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String

    Dim varSection As Variant
    Dim sTemp As String

    For Each varSection In Split(sInput, sDelimiter)
        If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
            sTemp = sTemp & sDelimiter & varSection
        End If
    Next varSection

    DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)

End Function

Here's some examples of how you would call it:

Sub tgr()

    MsgBox DeDupeString("1,2,3,4,5,2,2")    '--> "1,2,3,4,5"

    Dim myString As String
    myString = DeDupeString("4-2-5-1-3-2-2", "-")
    MsgBox myString     '--> "4-2-5-1-3"

End Sub

Upvotes: 9

Related Questions