Juggler_IN
Active Member
- Joined
- Nov 19, 2014
- Messages
- 358
- Office Version
- 2003 or older
- Platform
- Windows
Hi,
I have a code from Stackexchange, which is giving a runtime error 13 with 2 of the 3 supporting examples. And, I have not been able to decode why. Sub Example 3 executes but Sub Example 1 and Sub Example 2 fail.
Need help in getting it rectified.
I have a code from Stackexchange, which is giving a runtime error 13 with 2 of the 3 supporting examples. And, I have not been able to decode why. Sub Example 3 executes but Sub Example 1 and Sub Example 2 fail.
Need help in getting it rectified.
Code:
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
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
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
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