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

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