How to cut a part of a string?

Question

I'm trying to cut duplicates from a string i have.

The string looks like this:

word-1\word-2\word-3\word-3\word-3\word-3

And I wish it look like this: (without the duplications).

word-1\word-2\word-3

So far I thought of put the string into an array and split to items by \ . I don't really know how I suppose to cut the duplications. Moreover, I don't know how many duplicates gonna be.

This is what I got so far:

Sub Split_and_remove()
  ' split items on \
  Dim item As String, newItem As String
  Dim items As Variant, newItems As Variant
  item = Sheet1.Range("A1").Value2
  items = Split(item, "\")
  newItems = items(0) + "\" + items(1) + "\" + items(2)
  Sheet1.Range("A4").Value2 = newItems
End Sub

Thanks!

Use a `Scripting.Dictionary` to store the unique items and then `Join` to re-assemble them. — BigBen, Jan 14 '21 at 14:35

JvdV · Answer 1 · 2021-01-14T15:02:11.753

More roads to Rome:

FilterXML():

Sub tst()

Dim str1 As String, str2 As String

str1 = "word-1\word-2\word-3\word-3\word-3\word-3"
With Application
    str2 = Join(.Transpose(.FilterXML("<t><s>" & Replace(str1, "\", "</s><s>") & "</s></t>", "//s[not(preceding::*=.)]")), "\")
End With

End Sub

This would require Excel2013 and higher.

Dictionary:

More traditionally I'd also go with a dictionary:

Sub tst()

Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim arr As Variant, x As Long
Dim str1 As String, str2 As String

str1 = "word-1\word-2\word-3\word-3\word-3\word-3"
arr = Split(str1, "\")

For x = LBound(arr) To UBound(arr)
    dict(arr(x)) = 1
Next
str2 = Join(dict.Keys, "\")

End Sub

Coming from Microsoft Access VBA I didn't knew these Excel specific functions `Transpose` and `FilterXML`. Nice. — AHeyne, Jan 14 '21 at 14:49

AHeyne · Accepted Answer · 2021-01-14T15:03:29.113

This is an implementation with a collection, so you don't need an external object like a dictionary:

Public Function GetUniqueValues(ByVal valueString As String, ByVal delimiter As String) As String
    With New Collection
        On Error Resume Next

        Dim item As Variant
        For Each item In Split(valueString, delimiter)
            .Add item, item

            If Err.Number = 0 Then _
                GetUniqueValues = GetUniqueValues & item & delimiter

            Err.Clear
        Next item
    End With

    GetUniqueValues = Left(GetUniqueValues, Len(GetUniqueValues) - Len(delimiter))
End Function

It can be used with all variants of VBA, not only Excel.

score 1 · Answer 3 · answered Jan 14 '21 at 14:56

Try the next function, please:

Function elimDuplicates(x As String) As String
  Dim sh As Worksheet, arr
  
  Set sh = ActiveSheet
  arr = Split(x, "\")
  With sh.cells(1, ActiveSheet.UsedRange.Columns.count).Resize(UBound(arr) + 1, 1)
    .Value = Application.Transpose(arr)
    .RemoveDuplicates Columns:=1, Header:=xlNo
    arr = sh.Range(.cells(1, 1), sh.cells(sh.cells(rows.count, _
                    .Column).End(xlUp).row, .Column)).Value
    .Clear
  End With
  elimDuplicates = Join(Application.Transpose(Application.Index(arr, 0, 1)), "\")
End Function

It can be tested in this way:

Sub testElimDupl()
  MsgBox elimDuplicates("word-1\word-2\word-3\word-3\word-3\word-3")
End Sub

score 1 · Answer 4 · answered Jan 14 '21 at 14:58

Use Dictionary.

Sub Split_and_remove()

  Dim item As String, newItem As String
  Dim items As Variant, newItems As Variant
  
  item = Sheet1.Range("A1").Value2

  Sheet1.Range("A4").Value2 = getArray(item)
End Sub
Function getArray(s As String)
    Dim Dic As Object ' Dictionary
    Dim a As Variant, vArray As Variant

    Set Dic = CreateObject("Scripting.Dictionary")
    vArray = Split(s, "\")
    For Each a In vArray
        If Dic.Exists(a) Then
        Else
            Dic.Add a, a
        End If
    Next a
    getArray = Join(Dic.Keys, "\")
End Function

How to cut a part of a string?

4 Answers4