VBA script to split 0D, 1D, and 2D arrays 1

[jtm2020hyo]

Hello, I found a nice formula to manage arrays, but I do not have idea why this do not work with 0D arrays (unique cell) and 1D arrays (rows or columns), but this work correctly with 2D arrays.

for example, when I use this =JTM2dSplit(IFERROR(FILTER(M53:N60;L53:L60=1);"");";";";"), this return #value, but when use =JTM2dSplit(M56:N56;";";";") , this work correctly. I found that any formula like filter that return 0D or 1D array, the result is #value, but if I use another cell like support, then this work correctly.

the values used are: L53="2" M53="220" N53="220" L54="2" M54="220" N54="220" L55="2" M55="220" N55="220" L56="1" M56="220" N56="220" L57="2" M57="0" N57="0" L58="2" M58="0" N58="0" L59="2" M59="0" N59="0" L60="2" M60="0" N60="0"

Can someone help me to fix this code VBA excel?


here the code:

Option Base 1

Public Function JTM2DSplit(cellValues As Variant, DelimiterH As String, DelimiterV As String) As Variant
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Convert the input to a two-dimensional array of values if necessary
    If TypeName(cellValues) = "Range" Then cellValues = cellValues.Value2
    
    ' Handle cases where the input is a single value or an empty array
    cellValues = HandleInputCases(cellValues)
    
    ' Find the maximum length of the resulting arrays
    Dim MaxLengths As Variant
    MaxLengths = FindMaxLengths(cellValues, DelimiterH, DelimiterV)
    
    ' Redim the ResultArray to the appropriate size
    Dim ResultArray() As Variant
    ReDim ResultArray(1 To (UBound(cellValues, 1) * (MaxLengths(2) + 1)), 1 To (UBound(cellValues, 2) * (MaxLengths(1) + 1)))
    
    ' Populate the ResultArray with the split values
    ResultArray = PopulateResultArray(ResultArray, cellValues, DelimiterH, DelimiterV, MaxLengths)
    
    JTM2DSplit = ResultArray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Function

Private Function HandleInputCases(cellValues As Variant) As Variant
    If IsError(cellValues) Then
        HandleInputCases = CVErr(xlErrValue)
        Exit Function
    ElseIf IsEmpty(cellValues) Then
        HandleInputCases = ""
        Exit Function
    ElseIf Not IsArray(cellValues) Then ' Handle single value input (0D array)
        HandleInputCases = Handle0DArrayInput(cellValues)
    ElseIf IsArray(cellValues) And (UBound(cellValues, 2) - LBound(cellValues, 2)) = 0 Then ' Handle single column input (1D array)
        HandleInputCases = Handle1DColumnArrayInput(cellValues)
    ElseIf IsArray(cellValues) And (UBound(cellValues, 1) - LBound(cellValues, 1)) = 0 Then ' Handle single row input (1D array)
        HandleInputCases = Handle1DRowArrayInput(cellValues)
    Else
        HandleInputCases = cellValues
    End If
End Function

Private Function HandleErrorInput(cellValues As Variant) As Variant
    HandleErrorInput = CVErr(xlErrValue)
End Function

Private Function HandleEmptyInput(cellValues As Variant) As Variant
    HandleEmptyInput = ""
End Function

Private Function Handle0DArrayInput(cellValues As Variant) As Variant
    Dim tempValue As Variant
    tempValue = cellValues
    ReDim cellValues(1 To 1, 1 To 1)
    cellValues(1, 1) = tempValue
    Handle0DArrayInput = cellValues
End Function

Private Function Handle1DColumnArrayInput(cellValues As Variant) As Variant
    Dim tempArray() As Variant
    ReDim tempArray(LBound(cellValues, 1) To UBound(cellValues, 1), 1 To 1)
    Dim i As Long
    For i = LBound(cellValues, 1) To UBound(cellValues, 1)
        tempArray(i, 1) = cellValues(i, 1)
    Next i
    cellValues = tempArray
    Handle1DColumnArrayInput = cellValues
End Function

Private Function Handle1DRowArrayInput(cellValues As Variant) As Variant
    Dim tempArray() As Variant
    ReDim tempArray(1 To 1, LBound(cellValues, 2) To UBound(cellValues, 2))
    Dim j As Long
    For j = LBound(cellValues, 2) To UBound(cellValues, 2)
        tempArray(1, j) = cellValues(1, j)
    Next j
    cellValues = tempArray
    Handle1DRowArrayInput = cellValues
End Function



Private Function FindMaxLengths(cellValues As Variant, DelimiterH As String, DelimiterV As String) As Variant
    Dim TempArrayHorizontal() As String
    Dim TempArrayVertical() As String
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim MaxLengthH As Long: MaxLengthH = 0
    Dim MaxLengthV As Long: MaxLengthV = 0
    
    For i = LBound(cellValues, 1) To UBound(cellValues, 1)
        For j = LBound(cellValues, 2) To UBound(cellValues, 2)
            If Not IsEmpty(cellValues(i, j)) And cellValues(i, j) <> "" Then ' Check if the cell value is not blank or empty before attempting to split it
                
                ' Handle cases where DelimiterV is an empty string
                If DelimiterV = "" Then
                    ReDim TempArrayVertical(0 To 0)
                    TempArrayVertical(0) = cellValues(i, j)
                Else
                    TempArrayVertical = Split(cellValues(i, j), DelimiterV)
                End If
                
                If UBound(TempArrayVertical) > MaxLengthV Then MaxLengthV = UBound(TempArrayVertical)
                For k = LBound(TempArrayVertical) To UBound(TempArrayVertical)
                    
                    ' Handle cases where DelimiterH is an empty string
                    If DelimiterH = "" Then
                        ReDim TempArrayHorizontal(0 To 0)
                        TempArrayHorizontal(0) = TempArrayVertical(k)
                    Else
                        TempArrayHorizontal = Split(TempArrayVertical(k), DelimiterH)
                    End If
                    
                    If UBound(TempArrayHorizontal) > MaxLengthH Then MaxLengthH = UBound(TempArrayHorizontal)
                Next k
            End If
        Next j
    Next i
    
    FindMaxLengths = Array(MaxLengthH, MaxLengthV)
End Function



Private Function PopulateResultArray(ResultArray() As Variant, cellValues As Variant, DelimiterH As String, DelimiterV As String, MaxLengths As Variant) As Variant
    
    Dim SplitHorizontal() As String
    Dim SplitVertical() As String
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    
    Dim l As Long: l = 1
    
    For i = LBound(cellValues, 1) To UBound(cellValues, 1)
        Dim m As Long: m = 1
        For j = LBound(cellValues, 2) To UBound(cellValues, 2)
            If Not IsEmpty(cellValues(i, j)) And cellValues(i, j) <> "" Then ' Check if the cell value is not blank or empty before attempting to split it
                
                ' Handle cases where DelimiterV is an empty string
                If DelimiterV = "" Then
                    ReDim SplitVertical(0 To 0)
                    SplitVertical(0) = cellValues(i, j)
                Else
                    SplitVertical = Split(cellValues(i, j), DelimiterV)
                End If
                
                For k = LBound(SplitVertical) To UBound(SplitVertical)
                    
                    ' Handle cases where DelimiterH is an empty string
                    If DelimiterH = "" Then
                        ReDim SplitHorizontal(0 To 0)
                        SplitHorizontal(0) = SplitVertical(k)
                    Else
                        SplitHorizontal = Split(SplitVertical(k), DelimiterH)
                    End If
                    
                    Dim n As Long
                    For n = LBound(SplitHorizontal) To UBound(SplitHorizontal)
                        ResultArray(l + k, m + n) = SplitHorizontal(n)
                    Next n
                Next k
            End If
            m = m + MaxLengths(1) + 1
        Next j
        l = l + MaxLengths(2) + 1
    Next i
    
    PopulateResultArray = ResultArray
    
End Function

 

[remeng]

Hi,

I'm not sure I fully understand what you are attempting to do, but it seems like you are trying to split a cell value with a delimiter at some point. If that is the case, try the formula =textsplit() already built into Excel.

Link

 

[strongm]

>the formula =textsplit() already built into Excel.

the formula =textsplit() already built into Excel 365.

 

[jtm2020hyo]

=textsplit does not appear in my MS Office 2021 version. What should I do?

 

[combo]

If cellValues is passed as range, after cellValues = cellValues.Value2, cellValues is either 2D array or single value, and it seems that it is processed properly.

For me the issue is in IFERROR function. =IFERROR(FILTER(M53:N60;L53:L60=1);"") returns first argument if it is an array formula, otherwise the second one. So the question may be how properly pass range/array to your UDF. As a first test I would remove IFERROR function in argument. I have no FILTER function in my Excel to test, if it returns Range, it should be enough.

BTW, for me the functions Handle1DColumnArrayInput and Handle1DRowArrayInput do nothing, as the value from single row/column is a 2D array too.

combo

 

[jtm2020hyo]

Thanks for the help, until I understand, this VBA script only manages 2D arrays, but contain code to manage 0D and 1D arrays management...

... Then the solution is change "cellValues As Variant" to anything that accept 0D, 1D, 2D arrays, how do this change?

 

[Andrzejek]

I understand 1D and 2D arrays (well, even 3D arrays, like a Rubik's Cube), but what is a 0D array?

Just curious...

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[jtm2020hyo]

1D Rows or columns
0D a cell

 

[Andrzejek]

So, '0D array' is a 1D array with just one element.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[combo]

When you pick data from excel range you get either single value (from single cell) or 2D array. It would most straightforward to count the input cells, if 1 then assign the value to 1 x 1 2D array.

If 2D array is not the only output option, 4D array can be alternative, with the last two dimensions for splitted values.

Have you solved your initial problem with UDF #value return?

combo

 

[jtm2020hyo]

I am not too good with VBA, I did not found any error in the vba, should work, but I still have same error when I use 0D and 1D arrays.