×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

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

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

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

(OP)
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:

CODE --> vba_excel

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 

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

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

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

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

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

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

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

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

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

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

(OP)
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?

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

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

Just curious... ponder

---- Andy

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

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

(OP)
1D Rows or columns
0D a cell

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

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

---- Andy

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

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

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

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

(OP)
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.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close