good afternoon. I am trying to write my function to output a list to a cell (drop-down list using data validation).
It was assumed that a list is specified where the elements are encoded according to the following structure: parent pointer | pointer to children | Item text.
At the moment, the function is only half ready and is able to read only the specified list. But already at this stage, I wanted to test it and try to add a drop-down list through the check of the cell.
It was not possible to do this directly, and I tried to add through the Named Range.
I am not asking to end the function, however, I am asking you to suggest how to make the dropdown list. Maybe my function does not return something (although it does return an array). How do I get my plan into action?
'Definition of structure
Type Node
Name As String
ID As Long
Level As Long
ChildrenMas() As Long 'an array of links to child Nodes
Parent As Long 'indicates a link to the parent
ParentMarker As String 'indicates the parent symbol
ChildrenMarker As String 'indicates the symbol that children expect for this parent
ThisIsRoot As Boolean 'For the root - true, for the rest - false
DeepCount As Long ' Number of offspring in all subsequent generations
UsedInFinalTree As Boolean 'the attribute is set at the time of determining the place in the tree for the node
End Type
Type Tree
Name As String
ElementsCount As Long
Levels As Long
End Type
Function MultilevelList(Range As Range, _
Optional Delimiter As String = "|", _
Optional Levell As Long = 0, _
Optional OutputInformation As String = "text")
ReDim RangeAsString(1 To Range.Count) As String
Dim RangeAsStringCount As Long
Dim c As Range
Dim NodesArray() As Node 'an array of tree nodes
Dim ReturnedNodesArray() As Node 'an array of tree nodes for output
Dim ReturnedNodesArrayNames() As String
Dim m As Node
Dim NewTree As Tree 'creating a tree
Dim i, j, k, SLong As Integer
Dim S As String
Dim a() As String 'array to divide the string
Dim tm, td As Boolean
i = 1
For Each c In Range
RangeAsString(i) = c.Text
i = i + 1
Next c
RangeAsStringCount = Range.Count
NewTree.Name = "Tree"
'define the length of the array as the length of the resulting Range of strings
ReDim NodesArray(1 To UBound(RangeAsString))
For i = 1 To UBound(NodesArray)
NodesArray(i).ParentMarker = "_none_ParentMarker" & i
NodesArray(i).ChildrenMarker = "_none_ChildrenMarker" & i
Next i
k = 1
For i = 1 To UBound(RangeAsString)
SLong = 0
S = RangeAsString(i)
For j = 1 To Len(S)
If Delimiter = Mid(S, j, 1) Then SLong = SLong + 1
Next
If SLong >= 2 Then
a = Split(S, Delimiter, 3)
NodesArray(k).ID = k
NodesArray(k).ParentMarker = a(0)
NodesArray(k).ChildrenMarker = a(1)
NodesArray(k).Name = a(2)
If NodesArray(k).ParentMarker = "" Then
NewTree.Levels = 1
NewTree.ElementsCount = NewTree.ElementsCount + 1
NodesArray(k).Level = 1
NodesArray(k).ThisIsRoot = True
NodesArray(k).UsedInFinalTree = True
RangeAsString(i) = Empty
RangeAsStringCount = RangeAsStringCount - 1
End If
If i + 1 <> UBound(RangeAsString) Then k = k + 1
Else
RangeAsString(i) = Empty
RangeAsStringCount = RangeAsStringCount - 1
End If
Next i
tm = False
Do Until RangeAsStringCount < 1
If tm = True Then Exit Do
td = False
For i = 1 To UBound(NodesArray)
If NodesArray(i).Level = 0 Then
For j = 1 To UBound(NodesArray)
If NodesArray(i).ParentMarker = NodesArray(j).ChildrenMarker And _
NodesArray(j).Level <> 0 Then
If IsNotEmptyArray(NodesArray(j).ChildrenMas) Then
k = UBound(NodesArray(j).ChildrenMas)
ReDim Preserve NodesArray(j).ChildrenMas(1 To UBound(NodesArray(j).ChildrenMas) + 1)
k = k + 1
NodesArray(j).ChildrenMas(k) = i
NodesArray(i).Level = NodesArray(j).Level + 1
NodesArray(i).UsedInFinalTree = True
NodesArray(i).Parent = j
RangeAsStringCount = RangeAsStringCount - 1
td = True
Else
k = 0
ReDim Preserve NodesArray(j).ChildrenMas(1 To 1)
NodesArray(j).ChildrenMas(1) = i
NodesArray(i).Level = NodesArray(j).Level + 1
NodesArray(i).UsedInFinalTree = True
NodesArray(i).Parent = j
RangeAsStringCount = RangeAsStringCount - 1
td = True
End If
B = B
End If
Next j
End If
Debug.Print i
If td = False Then RangeAsStringCount = RangeAsStringCount - 1
Next i
Loop
ReDim ReturnedNodesArray(1 To UBound(NodesArray))
ReDim ReturnedNodesArrayNames(1 To UBound(NodesArray))
k = 0
For i = 1 To UBound(NodesArray)
If Levell = 0 Then
If NodesArray(i).UsedInFinalTree = True Then
k = k + 1
ReturnedNodesArray(k) = NodesArray(i)
ReturnedNodesArrayNames(k) = ReturnedNodesArray(k).Name
End If
Else
If NodesArray(i).Level = Levell And NodesArray(i).UsedInFinalTree = True Then
k = k + 1
ReturnedNodesArray(k) = NodesArray(i)
ReturnedNodesArrayNames(k) = ReturnedNodesArray(k).Name
End If
End If
Next i
ReDim Preserve ReturnedNodesArray(1 To k)
ReDim Preserve ReturnedNodesArrayNames(1 To k)
B = UBound(RangeAsString)
If OutputInformation = "text" Then
MultilevelList = WorksheetFunction.Transpose(ReturnedNodesArrayNames)
'MultilevelList = ReturnedNodesArrayNames
End If
End Function
'function to check the initialized youth of the array
Function IsNotEmptyArray(parArray As Variant) As Boolean
On Error Resume Next
IsNotEmptyArray = LBound(parArray) <= UBound(parArray)
End Function
