VBA - How to build an array with multiple delimiters of varying sizes?

Question

How can I build an array if I have multiple delimiters, where some delimiters are single character and others are multiple characters?

Sub Example()
    Dim exString As String
    Dim myString() As String

    exString = "A,B C;D > E"

    myString() = Split(exString, "," & " " & ";" & " > ")
End Sub

The result I want in my array is:

myString(0) is A
myString(1) is B
myString(2) is C
myString(3) is D
myString(4) is E

But using Split() in this way doesn't work. I do know that I can use Replace() to replace every single delimiter with a common one, but I have a lot of different delimiters and variations of multiple character delimiters. Using Replace() isn't desirable to me. What can I do?

Answer 1

You can have lots of problems in VBA as well:

'Add a reference to Microsoft VBScript Regular Expressions 5.5 (Tools -> References...)

Dim exString As String
exString = "A,B C;D > E"

Dim re As New RegExp
re.Pattern = "(,| |;|>)+"
re.Global = True

Dim myString() As String
myString = Split(re.Replace("A,B C;D > E", ","), ",")

Setting re.Pattern defines what to look for. | represents finding A or B, so the regular expression will match on , or or ; or >.

Multiple instances should be treated as one (e.g. between the D and the E there are three characters, but there should be only one split), so add a + at the end (and wrap everything else in ()).

Replace then replaces any of the matched patterns with , and gives back a string like this:

A,B,C,D,E

on which we can simply call Split to get back the array.

• Reference: VBScript Regular Expressions

---

Instead of using regular expressions to match the delimiter characters, you could use regexes to match the non-delimiter characters:

Dim re As New RegExp
re.Pattern = "[^, ;>]+"   'The ^ unmatches any characters within the []
re.Global = True

Dim match As Match
For Each match In re.Execute(exString)
    'do something with each result here
    Debug.Print match.Value
Next

This is sufficient if all you need is to iterate over the results and do something with them. If you specifically need an array with the results:

Dim re As New RegExp
re.Pattern = "[^, ;>]+"
re.Global = True

Dim matches As MatchCollection
Set matches = re.Execute(exString)
ReDim myString(matches.Count) As String
Dim i As Integer
For i = 0 To matches.Count - 1
    myString(i) = matches(i).Value
Next

Answer 2

In this situation, I found the following function to be perfect for my needs:

Function MultiSplit(SourceText As String, Optional SingleCharDelimiter As String, Optional MultiCharDelimiter As String, _
    Optional Separator As String) As String()
'Created by Tyeler for use by all.
'SourceText is your input string.
'SingleCharDelimiter is a string of desired delimiters.
'SingleCharDelimiter format is a string fully concatenated with no character separation.
'  (ex. "-.;:, " MultiSplit will use those 6 characters as delimiters)
'SingleCharDelimiter's will remove blanks from the array in the event two single delimiters
'  are next to each other.
'MultiCharDelimiter is a string of specific multi-character delimiters.
'MultiCharDelimiters can be separated by the optional Separator
'Separator is an optional value used to separate multiple MultiCharDelimiters.
'  (ex. MultiCharDelimiter = "A A,B B,C C" // Separator = "," // This will make the function
'    delimit a string by "A A", "B B", and "C C")
'MultiSplit will make an array based on any delimiter (Including delimiters with
'  multiple characters).


    If MultiCharDelimiter = "" And SingleCharDelimiter = "" Then Exit Function
    Dim i As Integer, n As Integer, dlimit
    Dim delColl As New Collection
    Dim newString As String: newString = SourceText
    Dim delArr() As String, strgArr() As String, delFull() As String
    Dim delSep As String, a As Integer: a = 33

    Do While InStr(SingleCharDelimiter, Chr(a)) <> 0 Or InStr(MultiCharDelimiter, Chr(a)) <> 0 _
        Or InStr(Separator, Chr(a)) <> 0 Or InStr(SourceString, Chr(a)) <> 0 'Find intermediate delimiter
            a = a + 1
    Loop
    delSep = Chr(a)

    If MultiCharDelimiter <> "" Then
        If Separator <> "" Then 'If there's no delimiter for the delimiter array, assume MultiCharDelimiter is the delimiter
            delArr() = Split(MultiCharDelimiter, Separator)
            For i = 0 To UBound(delArr)
                If InStr(newString, delArr(i)) <> 0 Then newString = Replace(newString, delArr(i), delSep)
            Next i
        Else
            newString = Replace(newString, MultiCharDelimiter, delSep)
        End If
    End If
    Erase delArr

    For i = 1 To Len(SingleCharDelimiter) 'Build a collection of user defined delimiters
        delColl.Add Mid(SingleCharDelimiter, i, 1)
    Next i

    For Each dlimit In delColl 'Replace all delimiters in the string with a single common one
        newString = Replace(newString, dlimit, delSep)
    Next dlimit

    strgArr() = Split(newString, delSep)
    ReDim delFull(LBound(strgArr) To UBound(strgArr))
    n = LBound(strgArr)

    For i = LBound(strgArr) To UBound(strgArr) 'Get rid of empty array items
        If strgArr(i) <> "" Then
            delFull(n) = strgArr(i)
            n = n + 1
        End If
    Next i

    n = n - 1
    ReDim Preserve delFull(LBound(strgArr) To n)
    MultiSplit = delFull 'Send the delimited array
    Erase delFull
    Erase strgArr
End Function

This function will return an array of values that were separated by user defined delimiters.

To use this function, simply call on it and supply your full string and desired delimiters:

Sub Example1()
    Dim exString As String
    Dim myString() As String
    Dim c, n

    exString = "A,B C;D > E"

    myString() = MultiSplit(exString, ", ;", " > ")
    n = 0
    For Each c In myString
        Debug.Print "(" & n & ") = " & c
        n = n + 1
    Next c
End Sub

This will yield the desired result where the array is filled with only ABCDE.

A more complicated example:

Sub Example2()
    Dim myString As String, c, n

    n = 0
    myString = "The,Quickupside-downBrownjelloFox_Jumped[Over]             ThegiantLazyjelloDog"

    For Each c In MultiSplit(myString, ",_[] ", "upside-down,jello,giant", ",")
        Debug.Print "(" & n & ") = " & c
        n = n + 1
    Next c
End Sub

This will yield the following:

Answer 3

You were on the right track with your function. Using a ParamArray you can easily change the number and position of your delimiters.

Code

Function MultiSplit(SourceText As String, ParamArray Delimiters()) As String()
    Dim v As Variant

    For Each v In Delimiters
        SourceText = Replace(SourceText, v, "•")
    Next

    MultiSplit = Split(SourceText, "•")

End Function

Test

Sub Test()
    Const example As String = "A,B C;D > E"
    Dim a1, a2, a3, Incorrect

    Incorrect = MultiSplit(example, " ", " > ")
    a1 = MultiSplit(example, " > ", ",", ";", " ")
    a2 = MultiSplit(example, " > ", ",")
    a3 = MultiSplit(example, " > ")
End Sub

Result

NOTE: When using multi-character delimiters, the order that the delimiters are processed matters. Notice that A1 is split proper but Incorrect is not split as intended because the space delimiter came before " > ".

Answer 4

The following is a built-upon version of the code that Thomas Inzina graciously provided.

The following limitations have been removed:

• The order that the delimiters are listed in the function.
• The temporary delimiter being a set specific character.
• The option to include or remove empty array items.
• The function changing the reference (ByRef vs ByVal)
• Passing an array of delimiters vs listing individual delimiters

Function MultiSplitX(ByVal SourceText As String, RemoveBlankItems As Boolean, ParamArray Delimiters()) As String()
    Dim a As Integer, b As Integer, n As Integer
    Dim i As Integer: i = 251
    Dim u As Variant, v As Variant
    Dim tempArr() As String, finalArr() As String, fDelimiters() As String

    If InStr(TypeName(Delimiters(0)), "()") <> 0 And LBound(Delimiters) = UBound(Delimiters) Then
        ReDim fDelimiters(LBound(Delimiters(0)) To UBound(Delimiters(0))) 'If passing array vs array items then
        For a = LBound(Delimiters(0)) To UBound(Delimiters(0))            'build that array
            fDelimiters(a) = Delimiters(0)(a)
        Next a
    Else
        fDelimiters = Delimiters(0)
    End If

    Do While InStr(SourceText, Chr(i)) <> 0 And i < 251 'Find an unused character
        i = i + 1
    Loop
    If i = 251 Then 'If no unused character in SourceText, use single character delimiter from supplied
        For a = LBound(fDelimiters) To UBound(fDelimiters)
            If Len(fDelimiters(a)) = 1 Then i = Asc(fDelimiters(a))
        Next a
    End If
    If i = 251 Then 'If no single character delimiters can be used, error.
        MsgBox "SourceText uses all character type." & vbCrLf & "Cannot split SourceText into an array.", _
            vbCritical, "MultiSplitX Run-Time Error"
        Exit Function
    End If
    Debug.Print i


    For a = LBound(fDelimiters) To UBound(fDelimiters) 'Sort Delimiters by length
        For b = a + 1 To UBound(fDelimiters)
            If Len(fDelimiters(a)) < Len(fDelimiters(b)) Then
                u = fDelimiters(b)
                fDelimiters(b) = fDelimiters(a)
                fDelimiters(a) = u
            End If
        Next b
    Next a

    For Each v In fDelimiters 'Replace Delimiters with a common character
        SourceText = Replace(SourceText, v, Chr(i))
    Next

    tempArr() = Split(SourceText, Chr(i)) 'Remove empty array items
    If RemoveBlankItems = True Then
        ReDim finalArr(LBound(tempArr) To UBound(tempArr))
        n = LBound(tempArr)
        For i = LBound(tempArr) To UBound(tempArr)
            If tempArr(i) <> "" Then
                finalArr(n) = tempArr(i)
                n = n + 1
            End If
        Next i
        n = n - 1
        ReDim Preserve finalArr(LBound(tempArr) To n)

        MultiSplitX = finalArr
    Else: MultiSplitX = tempArr
    End If
End Function

Use of this function doesn't change from how Thomas had it, with the exception that there's an added boolean statement.

---

Example 1

In this example, RemoveBlankItems has been set to True.

Sub Example1()
    Dim myString As String, c, n

    n = 0
    myString = "The,Quickupside-downBrownjelloFox_Jumped[Over]             ThegiantLazyjelloDog"

    For Each c In MultiSplitX(myString, True, ",", "-", "upside-down", "jello", " ", "[", "]", "giant", "_")
        Debug.Print "(" & n & ") = " & c
        n = n + 1
    Next c
End Sub

This results in the following output:

---

Example 2

In this example we have RemoveBlankItems set to False.

Sub Example2()
    Dim myString As String, c, n

    n = 0
    myString = "The,Quickupside-downBrownjelloFox_Jumped[Over]             ThegiantLazyjelloDog"

    For Each c In MultiSplitX(myString, True, ",", "-", "upside-down", "jello", " ", "[", "]", "giant", "_")
        Debug.Print "(" & n & ") = " & c
        n = n + 1
    Next c
    Debug.Print myString
End Sub

This results in the following output:

---

Example 3

In this example, instead of listing our delimiters in the function, we have them typed out in a string and insert an array in the function instead:

Sub Example3()
    Dim myString As String, c, n
    Dim myDelimiters As String

    n = 0
    myString = "The,Quickupside-downBrownjelloFox_Jumped[Over]             ThegiantLazyjelloDog"
    myDelimiters = ",|-|upside-down|jello| |[|]|giant|_"

    For Each c In MultiSplitX(myString, True, Split(myDelimiters, "|"))
        Debug.Print "(" & n & ") = " & c
        n = n + 1
    Next c
    Debug.Print myString
End Sub

This has the same result as if they had been listed individually:

---

The Reason RemoveBlankItems Is Desirable

There are some instances in which you DON'T want to have blanks in your array. An example of this would be if you're using your array as a bank of search words that are cycling through a range on a spread sheet. Another example would be if you're manipulating strings of text based on values in the array.

There are also times when you would want to retain the blanks in the array. As Thomas described, in the event you're using this on a CSV file, where maintaining the spaces as columns is desired. Or you're using it to break apart, for example, HTML coding and wish to retain the line format.

Answer 5

Perhaps:

Sub Example()

    Dim exString As String
    Dim myString() As String

    exString = "A,B C;D > E"
    exString = Replace(exString, ",", " ")
    exString = Replace(exString, ";", " ")
    exString = Replace(exString, ">", " ")
    exString = Application.WorksheetFunction.Trim(exString)

    myString() = Split(exString, " ")

    msg = ""
    For Each a In myString
        msg = msg & vbCrLf & a
    Next a

    MsgBox msg
End Sub