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:
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
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 365.
RE: VBA script to split 0D, 1D, and 2D arrays
RE: VBA script to split 0D, 1D, and 2D arrays
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
... 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
Just curious...
---- Andy
"Hmm...they have the internet on computers now"--Homer Simpson
RE: VBA script to split 0D, 1D, and 2D arrays
0D a cell
RE: VBA script to split 0D, 1D, and 2D arrays
---- Andy
"Hmm...they have the internet on computers now"--Homer Simpson
RE: VBA script to split 0D, 1D, and 2D arrays
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