×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
• Talk With Other Members
• Be Notified Of Responses
• Keyword Search
Favorite Forums
• Automated Signatures
• 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.

# 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.

### 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...

---- 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.

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:

• Talk To Other Members
• Notification Of Responses To Questions
• Favorite Forums One Click Access
• Keyword Search Of All Posts, And More...

Register now while it's still free!