jtm2020hyo
Technical User
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:
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