Excel VBA formula for split rows and columns doesn't work

[haas67]

Hi All,

I've made a function like textsplit in VBA. I want to split a delimited string in rows and columns.

The function is:
Function Splitter3(data As String, col_delim As String, Optional row_delim As String) As Variant()
Dim arr1() As String
Dim arr2() As String
Dim result() As Variant

If row_delim <> "" Then
arr1 = Split(data, row_delim)
ReDim result(UBound(arr1))

For i = 0 To UBound(arr1)
arr2 = Split(arr1(i), col_delim)
result(i) = arr2
Next
Else
ReDim result(0)

arr2 = Split(data, col_delim)
result(0) = arr2
End If

Splitter3 = result
End Function

It works fine if the data string is made up of equal columns, but not if one column is missing from a row.

Formula: =Splitter3(A1, ",", ";")
Not working: "Apple,Orange,Peach;Strawberry,Mango,Grape;Raspberry,Kiwi"
Working: "Apple,Orange,Peach;Strawberry,Mango,Grape;Raspberry,Kiwi,x"

Do you see my mistake?

Regards,
Haas67

 

[haas67]

So you see the same problem. The #VALUE! error in cell A10.
And in Cell A14, you must enter with ctrl-shift-enter if you don't use excel 365, or re-enter if you do.

 

[igold]

Which I did do as indicated in Cell E14.

 

[igold]

My mistake- with 365 (which I did not know), there is no need to use CSE. It has populated correctly now for cell A2. Sorry about the confusion. Of course, this does not put you any closer to an answer to your question though.

 

[haas67]

The confusion is also caused by me, since i created the problem on my work laptop which has 365, and later made the xl2bb on my home laptop, which has excel 2016.
Therefor the cse. It should be able to work on both versions though.
It does with the string from cell A2.

 

[Alex Blakenburg]

Give this a try:

Function Splitter3(data As String, col_delim As String, Optional row_delim As String) As Variant()
    Dim arr1() As String
    Dim arr2() As String
    Dim result() As Variant
    Dim i As Long
    Dim arr2Max As Long
    
    If row_delim <> "" Then
        arr1 = Split(data, row_delim)
        ReDim result(UBound(arr1))
        
        For i = 0 To UBound(arr1)
            arr2 = Split(arr1(i), col_delim)
            If arr2Max < UBound(arr2) Then arr2Max = UBound(arr2)
            result(i) = arr2
        Next
    Else
        ReDim result(0)
        
        arr2 = Split(data, col_delim)
        result(0) = arr2
    End If
    
    For i = 0 To UBound(result)
        arr2 = result(i)
        ReDim Preserve arr2(0 To arr2Max)
        result(i) = arr2
    Next i
    
    Splitter3 = result
End Function

 

[haas67]

Give this a try:

Function Splitter3(data As String, col_delim As String, Optional row_delim As String) As Variant()
    Dim arr1() As String
    Dim arr2() As String
    Dim result() As Variant
    Dim i As Long
    Dim arr2Max As Long
   
    If row_delim <> "" Then
        arr1 = Split(data, row_delim)
        ReDim result(UBound(arr1))
       
        For i = 0 To UBound(arr1)
            arr2 = Split(arr1(i), col_delim)
            If arr2Max < UBound(arr2) Then arr2Max = UBound(arr2)
            result(i) = arr2
        Next
    Else
        ReDim result(0)
       
        arr2 = Split(data, col_delim)
        result(0) = arr2
    End If
   
    For i = 0 To UBound(result)
        arr2 = result(i)
        ReDim Preserve arr2(0 To arr2Max)
        result(i) = arr2
    Next i
   
    Splitter3 = result
End Function

Yes, this works fine.
I see that the declaration of every row is made the same length, even if is not filled.
Thanks a lot !

 

[Alex Blakenburg]

Yes that seemed to be the issue. It does use a dynamic array for the output though, so I suspect it won’t work on your Excel 2016 version (listed under your profile).

 

[haas67]

I made a fix myself for the case you only have a col_delim.
In that case, your loop over UBound(result) world destroy arr2, since there is no arr2Max in that case.
And I made the col_delim optional, so you can have a row_delim only =Splitter3(A1,,",")
Edit: It even works on excel 2016.

Function Splitter3(data As String, Optional col_delim As String, Optional row_delim As String) As Variant()
    Dim arr1() As String
    Dim arr2() As String
    Dim result() As Variant
    Dim i As Long
    Dim arr2Max As Long
   
    If row_delim <> "" Then
        arr1 = Split(data, row_delim)
        ReDim result(UBound(arr1))
       
        For i = 0 To UBound(arr1)
            arr2 = Split(arr1(i), col_delim)
            If arr2Max < UBound(arr2) Then arr2Max = UBound(arr2)
            result(i) = arr2
        Next
        For i = 0 To UBound(result)
            arr2 = result(i)
            ReDim Preserve arr2(0 To arr2Max)
            result(i) = arr2
        Next i
    Else
        ReDim result(0)
       
        arr2 = Split(data, col_delim)
        result(0) = arr2
    End If
   
   
    Splitter3 = result
End Function

 

[Alex Blakenburg]

I assume you know that Microsoft have released TextSplit to the beta channel,so we should get access to that in the not too distant future.
TEXTSPLIT function

 

[haas67]

I assume you know that Microsoft have released TextSplit to the beta channel,so we should get access to that in the not too distant future.
TEXTSPLIT function

Yes, I know. That was actually the reason I (tried to) make this macro. To see if I could make it work for Excel 2016 (which I still often use)

FYI:
I also have TextJoin and Unique:

Function TextJoin2(Delimiter As String, ignore_empty As Boolean, ParamArray cell_ar() As Variant)
For Each cellrng In cell_ar
    For Each cell In cellrng
        If ignore_empty = False Then
            result = result & cell & Delimiter
        Else
            If cell <> "" Then
                result = result & cell & Delimiter
            End If
        End If
    Next cell
Next cellrng
TextJoin2 = Left(result, Len(result) - Len(Delimiter))
End Function

Function Unique2(rng As Range) As Variant()
    Dim list As New Collection
    Dim Ulist() As Variant

    On Error Resume Next
    For Each Value In rng
        list.Add CStr(Value), CStr(Value)
    Next
    On Error GoTo 0

    ReDim Ulist(list.Count - 1, 0)

    For i = 0 To list.Count - 1
        Ulist(i, 0) = list(i + 1)
    Next

    Unique2 = Ulist
End Function