Newton Excel Bach, not (just) an Excel Blog

A recent post on the Tek-Tips VBA forum reminded me that VBA has a split function, which will split a string into sub-strings at any specified character (such as a space).  D’oh I thought, why did I waste my time writing my own split function when it is there in VBA already?  Then I remembered that if the string has multiple consecutive split characters (such as two or more consecutive spaces) the VBA split function will treat each of these as a separate sub-string, which is not normally what we want.

Writing a split function from scratch is one way around this problem, but the Microsoft on line documentation for VB gives an alternative.  The suggested code here uses the VB split function, then copies each non-blank member of the resulting array to a new array.  This works well if you want to split entire lines of text, but if you want to split only some of the text, and return the remainder as a single string, then this approach will not work.  To avoid this problem I wrote the code shown below, which removes all duplicate instances of the separator string, then uses the VBA split function on the resulting string.

Function SplitText2(Texta As Variant, Optional NumCols As Long = -1, Optional Separator As Variant = " ") As Variant
Dim NumLines As Long, i As Long, j As Long, Linea As Variant, Numwords As Long
Dim MaxWords As Long, SplitString As String, SplitString2 As String, LenString As Long, SplitCount As Long, NextChar As String
Dim AddChar As String, MaxCols As String</code>

If LCase(Separator) = "tab" Then Separator = Chr(9)
If Val(Separator) &gt; 0 Then Separator = Chr(CLng(Separator))

Texta = GetArray(Texta)
NumLines = UBound(Texta) - LBound(Texta) + 1
If NumCols = -1 Then MaxCols = 10 Else MaxCols = NumCols
ReDim Preserve Texta(1 To NumLines, 1 To MaxCols)

For i = 1 To NumLines
' Remove 2nd and subsequent consecutive separator characters
SplitString2 = ""
SplitString = Texta(i, 1)
LenString = Len(SplitString)
SplitCount = 0
For j = 1 To LenString
NextChar = Mid(SplitString, j, 1)
If NextChar = Separator Then
If SplitCount = 0 Then
SplitCount = 1
AddChar = NextChar
Else
AddChar = ""
End If
Else
AddChar = NextChar
SplitCount = 0
End If
SplitString2 = SplitString2 &amp; AddChar
Next j

'Split text
Linea = Split(SplitString2, Separator, NumCols)

' Add Linea to Texta
Numwords = UBound(Linea) - LBound(Linea) + 1
If Numwords &gt; MaxWords Then
MaxWords = Numwords
ReDim Preserve Texta(1 To NumLines, 1 To Numwords)
End If

For j = 0 To Numwords - 1
Texta(i, j + 1) = Linea(j)
Next j
Next i

SplitText2 = Texta
End Function
Function SplitText2(Texta As Variant, Optional NumCols As Long = -1, Optional Separator As Variant = " ") As Variant
Dim NumLines As Long, i As Long, j As Long, Linea As Variant, Numwords As Long
Dim MaxWords As Long, SplitString As String, SplitString2 As String, LenString As Long, SplitCount As Long, NextChar As String
Dim AddChar As String, MaxCols As String

If LCase(Separator) = "tab" Then Separator = Chr(9)
If Val(Separator) &gt; 0 Then Separator = Chr(CLng(Separator))

Texta = GetArray(Texta)
NumLines = UBound(Texta) - LBound(Texta) + 1
If NumCols = -1 Then MaxCols = 10 Else MaxCols = NumCols
ReDim Preserve Texta(1 To NumLines, 1 To MaxCols)

For i = 1 To NumLines
' Remove 2nd and subsequent consecutive separator characters
SplitString2 = ""
SplitString = Texta(i, 1)
LenString = Len(SplitString)
SplitCount = 0
For j = 1 To LenString
NextChar = Mid(SplitString, j, 1)
If NextChar = Separator Then
If SplitCount = 0 Then
SplitCount = 1
AddChar = NextChar
Else
AddChar = ""
End If
Else
AddChar = NextChar
SplitCount = 0
End If
SplitString2 = SplitString2 &amp; AddChar
Next j

'Split text
Linea = Split(SplitString2, Separator, NumCols)

' Add Linea to Texta
Numwords = UBound(Linea) - LBound(Linea) + 1
If Numwords &gt; MaxWords Then
MaxWords = Numwords
ReDim Preserve Texta(1 To NumLines, 1 To Numwords)
End If

For j = 0 To Numwords - 1
Texta(i, j + 1) = Linea(j)
Next j
Next i

SplitText2 = Texta
End Function

Note that this function lacks a couple of features found in my earlier Split function, but it does have the virtue of simplicity.