Removing Duplicate values from a string in VBA - vba

Question

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").

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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)

Answer 5

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