Split Text On Multiple Delimiters
This page describes two functions that are logical extensions of the VBA SPLIT function to allow
splitting a character string using multiple delimiter characters and/or multiple-character delimiters.
With VBA Version 6 (Office 2000), Microsoft introduced the Split function, which
splits a text string into an array, using a delimiter character or characters to indicate the separation between
words in the input string. For example, Split("ab|cd","|") returns a two element array,
the first element being ab and the second being cd. The
| character indidates the character that separates the strings. While Split does support
mutliple character separator strings (e.g., Split("ab|$cd","|$") would return elements
ab and cd), using the character sequence |$
as the delimiter string, it does not support multiple delimiters. For example, you
cannot use Split to split apart the string ab|cd$ef%gh where |,
$, and % are all considered text delimiters. This page describes
two functions that expand on the VBA Split: SplitMultiDelims that allows
you to specify any number of single-character delimiters, and SplitMultiDelimsEX which allows
you to specify any number of single- or multiple-character delimiters. For example, you can split the string
"yesterdaySTOPtodayENDtomrrowNEXTfuture" into the array {yesterday, today, tomorrow, future} by
specifying STOP, END, and NEXT as the delimiter
words. Of course, the delimiters need not be actual words; they may be any series of strings of any characters.
You can download an example bas module here.
The SplitMultiDelims function is used to split a string into substrings using any of the supplied characters
as delimiters between the substrings. Substrings are separated by any one character passed in the
DelimChars characters. All delimiter characters are treated as single characters and no one
character has any higher priority than any other character. That is, the order in which the character appear in the DelimChars string is
irrelevant. The function returns an array of substrings parsed out from the Text parameter using the
characters in the DelimChars parameter. If Text is empty, the function
returns an unallocated array. If DelimChars is empty, the entire Text value
is returned as a single element array.
If Text contains a|bc$def:ghij, and DelimChars
contains the string :|$, the result is the array {a, bc, def, ghij}.
If Text does not contain any of the characters in DelimChars, the function
returns a single element array containing all of Text.
Function SplitMultiDelims(Text As String, DelimChars As String) As String()
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
If Len(Text) = 0 Then
Exit Function
End If
If DelimChars = vbNullString Then
SplitMultiDelims = Array(Text)
Exit Function
End If
ReDim Arr(1 To Len(Text))
I = 0
N = 0
Pos1 = 1
For N = 1 To Len(Text)
For M = 1 To Len(DelimChars)
If StrComp(Mid(Text, N, 1), Mid(DelimChars, M, 1), vbTextCompare) = 0 Then
I = I + 1
Arr(I) = Mid(Text, Pos1, N - Pos1)
Pos1 = N + 1
N = N + 1
End If
Next M
Next N
If Pos1 <= Len(Text) Then
I = I + 1
Arr(I) = Mid(Text, Pos1)
End If
ReDim Preserve Arr(1 To I)
SplitMultiDelims = Arr
End Function
The function SplitMultiDelimsEX function is an extension of the SplitMultiDelims
function. Instead of being restricted to single-character delimiters, it allows for any number of multi-character string delimiters.
These delimiters are passed in the DelimStrings parameter, and each delimiter string in this parameter is
separated by the DelimStringsSep character. The strings in DelimStrings must not
use the DelimStringsSep except as the string separator. The function returns an unallocated array
if Text is empty, the full contents of Text as a single element array if DelimStrings
is empty, or an array of 1 to many elements each of which is a substring of Text, separated by any string in the
DelimStrings. The elements of DelimStrings are treated equally. That is,
the order of the strings in DelimStrings is irrelevant.
Function SplitMultiDelimsEX(Text As String, DelimStrings As String, _
DelimStringsSep As String) As String()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SplitMultiDelimsEX
' This function is like VBA's Split function or the SplitMultiDelims
' function, also in this module. It accepts any number of multiple-
' character delimiter strings and splits Text into substrings based
' on the delimiter strings. It returns an unallocated array if Text
' is empty, a single-element array if DelimStrings is empty, or a
' 1 or greater element array if Text was successfully split into
' substrings based on the DelimStrings delimiters.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Pos1 As Long
Dim N As Long
Dim M As Long
Dim Arr() As String
Dim I As Long
Dim DelimWords() As String
Dim DelimNdx As Long
Dim DelimWord As String
'''''''''''''''''''''''''''''
' if Text is empty, get out
'''''''''''''''''''''''''''''
If Len(Text) = 0 Then
Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''
' if there are no delimiters, return the whole text
'''''''''''''''''''''''''''''''''''''''''''''''''''
If DelimStrings = vbNullString Then
SplitMultiDelimsEX = Array(Text)
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''
' if there is no delim separator, get out
''''''''''''''''''''''''''''''''''''''''''
If DelimStringsSep = vbNullString Then
Exit Function
End If
DelimWords = Split(DelimStrings, DelimStringsSep)
If IsArrayAllocated(DelimWords) = False Then
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''
' oversize the array, we'll shrink it later so
' we don't need to use Redim Preserve
''''''''''''''''''''''''''''''''''''''''''''''''
ReDim Arr(1 To Len(Text))
I = 0
N = 0
Pos1 = 1
For N = Pos1 To Len(Text)
For DelimNdx = LBound(DelimWords) To UBound(DelimWords)
DelimWord = DelimWords(DelimNdx)
If StrComp(Mid(Text, N, Len(DelimWord)), DelimWord, vbBinaryCompare) = 0 Then
I = I + 1
Arr(I) = Mid(Text, Pos1, N - Pos1)
Pos1 = N + Len(DelimWord)
N = Pos1
End If
Next DelimNdx
Next N
If Pos1 <= Len(Text) Then
I = I + 1
Arr(I) = Mid(Text, Pos1)
End If
''''''''''''''''''''''''''''''''''''
' chop off unused array elements
''''''''''''''''''''''''''''''''''''
ReDim Preserve Arr(1 To I)
SplitMultiDelimsEX = Arr
End Function
You can download an example bas module here.
This page last updated: 20-September-2007