Home » excel » excel – How to find the end of a tree process in vba

excel – How to find the end of a tree process in vba

Posted by: admin April 23, 2020 Leave a comment

Questions:

I have an excel worksheet with operations and time associated with each operation. And these operations are linked, some have successors, some don’t.

I created a macro to find the direct successors of an operation and it works well.

But what I want to do is to find ALL the successors of an operation. I mean counting the successors’ successors and so on, because I want to see how much time is impacted if I cancel or stop this operation.

Here is an example of what it can look like:

   Lvl1   Lvl2  Lvl3  Lvl4   Lvl5
                OP3---OP5----OP6
               /
              /
           OP1
          /   \
         /     \
        /       OP4
    OP0
        \ 
         \
          \
           OP2---OP7

In this example, to go from one level to another I have to run my macro (if there are no more successors to an operation my macro returns an empty array).

So, the aim is to add the time of all these operation to find the result.

But I can’t figure how to make my loops to stop when there are no more successors to one operation and then go to the next one.

For example here, how do I know I have to go back to OP4 when I reached OP6

PS: Here is a simplified version of my macro (I don’t have the successors of each operation in my file but only the predecessors, that’s why I have to look through the file to find if the operation I want is in each operation’s predecessors list)

OP_number = "ER345RET"

For i = 2 To File_size
    Predecessors = Split(Worksheets(1).Range("S" & i).Value, ";")
    For j = 0 To UBound(Predecessors)
        If Predecessors(j) = OP_number Then
            Successors(q) = Worksheets(1).Range("F" & i).Value
            q = q + 1
        End If
    Next j
Next i
How to&Answers:

Recursion is most likely your best option for this task. The recursive function would look something like this (pseudo code):

'Recursive function returns count of successors
Function getSuccessor(predecessor As String) As Long
    'Check if this predecessor has a successor
        'If Yes then call self (getSuccessor) with new predecessor
            getSuccessor = getSuccessor(myNewSuccessor)

        'If No set exit condition
            getSuccessor = 1  'one increases the count for this level
End Function

It appears that your trying to build an array of each successor as you go. You can do this by adding the new item to the array just before you recursively call the getSuccessor function. You’ll probably want a global array to store it in.

'If Yes then call self (getSuccessor) with new predecessor
    Successors(x) = myNewSuccessor
    getSuccessor = getSuccessor(myNewSuccessor)

The main function would look like something like this:

Sub recursion()
    Dim count As Integer
    OP_number = "ER345RET"

    For i = 2 To File_size
        'set topLevelPredecessor
        count = getSuccessor(topLevelPredecessor)
    Next i

    MsgBox ("Total Levels of successors is: " & count)
End Sub

Answer:

With data like this:

F       S
OP0 
OP1     OP0
OP2     OP0
OP3     OP1
OP4     OP1
OP5     OP3
OP6     OP5
OP7     OP2

Then this code will put all the successors in an array

Sub Main()

    Dim vaPreds As Variant
    Dim aSuccs() As String
    Dim vaOps As Variant
    Dim lCnt As Long
    Dim i As Long

    'Create a two-dimensional array of predecessors
    'from column S
    vaPreds = Sheet1.Range("S2:S8").Value
    'Create a two-dim array of operations from
    'column F
    vaOps = Sheet1.Range("F1:F8").Value

    'Call the function that will load the successors
    'into the aSuccs() array variable
    FindPreds "OP0", vaPreds, aSuccs, vaOps, lCnt

    'Loop through the final successors array and
    'print them to the Immediate Window
    For i = LBound(aSuccs) To UBound(aSuccs)
        Debug.Print aSuccs(i)
    Next i

End Sub

Sub FindPreds(ByVal sOpStart As String, ByRef vaPreds As Variant, ByRef vaSuccs As Variant, ByRef vaOps As Variant, ByRef lCnt As Long)

    Dim vaSplit As Variant
    Dim i As Long, j As Long

    'Loop through all the predecessors
    For i = LBound(vaPreds, 1) To UBound(vaPreds, 1)
        'Split the predecessors on semi colon for cells
        'where there are more than one.
        vaSplit = Split(vaPreds(i, 1), ";")
        'Loop through the split predecessors
        For j = LBound(vaSplit) To UBound(vaSplit)
            'If the predecessor is the operation I'm looking
            'for, add the operation to the successors array
            If vaSplit(j) = sOpStart Then
                lCnt = lCnt + 1
                ReDim Preserve vaSuccs(1 To lCnt)
                vaSuccs(lCnt) = vaOps(i + 1, 1)

                'Go find any successors for the operation you just
                'added to the successors array
                FindPreds vaOps(i + 1, 1), vaPreds, vaSuccs, vaOps, lCnt

            End If
        Next j
    Next i

End Sub

Answer:

I finally found how to tweak the problem.

Instead of going through every branch of the tree one by one, I decided to go through every branch at once. And stopping the iterations when I don’t have any successors left.

Here is the bit of code I wrote:

q = 1
qstop = 1

Opdaughters(1, 0) = OP_number

For i = 2 To Size
    If Worksheets("XXX").Range("J" & i) = OP Then
        Opfilles(2, 0) = Worksheets("XXX").Range("O" & i)
    End If
Next i

Call Macro(OP_number, q, Opdaugthers)

Buffer() = Opdaughters()

While q <> qstop
    retenue = q
    For i = qstop To q
        Call Macro(Buffer(1, i), q, Opdaughters)
        ReDim Preserve Buffer(2, UBound(Opdaughters, 2))
    Next i
    qstop = retenue
    Buffer() = Opdaughters()
Wend

Basically I make my table OPdaughters grow by adding the successors at the end of it. Then when no more successors are added to my table (ie when q=qstop) it means that I reached the end of my process.

Here is an example of what my table OPdaughters looks like through the iterations:

Iteration0    Iteration1    Iteration2
    OP0          OP0           OP0
                 OP1           OP1
                 OP2           OP2
                 OP3           OP3
                               OP11
                               OP12
                               OP21
                               OP31
                               OP32
                               OP33