none
redundant task dependencies

    Pertanyaan

  • I have to analyze the relations of the FS type between activities, in order to eliminate the redundant relationships.

    https://social.technet.microsoft.com/Forums/getfile/1365576

    In the example shown, the FS relation between task 1 and 4 is useless and redundant.

    In a Gantt with many activities it is difficult to identify these relationships.

    I would like to develop a sub-vba to identify these possible redundancies but I have not succeeded.

    Marco

    Jumat, 30 November 2018 09.40

Semua Balasan

  • Marco,

    Wow, that's a very tall order. I can see no quick or easy way to tell that task 4 is linked to task 1 in two separate "chains" without looping through all dependencies and looking for potential matches. What you show is a very straightforward simple link chain. In a normal Project file there could be many more complex variations of the redundant links.

    Could it be done? Probably, but not without a great deal of complex coding. Now I'm all about developing challenging VBA macros, but this is one I'll pass on (i.e. no thanks).

    Although your plan may have several such redundant link paths, are they really causing any significant problems? You might just be better off to leave them alone and be more discerning about creating the network logic the next time a plan is created. However, if you are still concerned about the redundant paths, you might try a iterative analysis by visually perusing through the plan and looking for areas where it appears redundancy might be a factor and then isolating those areas for a closer look and taking appropriate action if necessary.

    My thoughts.

    John

    Jumat, 30 November 2018 15.31
  • Marco,

    A general-purpose algorithm for automatically finding and tagging/removing redundant logic is a pretty tall order.  What works for your simple 4-task example may not work for a master project of 5000 tasks in 9 different sub-projects.  Only one third-party Add-in that I know of - Acumen Fuse from Deltek - claims to do the job.  In light of its price tag, you may find a manual approach more palatable.

    By the way,

    a. Redundant logic typically imposes negligible calculation burden and does not degrade the calculated schedule in any way.

    b. Redundant logic is sometimes a useful safeguard when there is a significant possibility that tasks will be completed out-of-sequence.  An automated routine generally won't account for this.

    c. The primary arguments against such redundant logic (aside from software marketing) are:

    • The extra relationship lines can complicate a visual review of the schedule.
    • The scheduler is personally embarrassed by his or her failure to recognize and remove the redundancies as superseding logic is added to the schedule.

     Though I could certainly develop a robust routine, I've considered these reasons insufficient to justify the effort.

    Good luck, tom

    [Apologies to John for the near-concurrent post.]
    Jumat, 30 November 2018 15.52
  • Tom,

    No apology necessary. Once again we not only are reading the same book, but we are on exactly the same page :-)

    John

    Jumat, 30 November 2018 18.13
  • First of all thank you for your answers.
    I agree with you, but there are programs that calculate risks and these redundant logics increase the number of risks to be analyzed.
    I imagine a tool that can highlight the redundant relationship but the planner has to evaluate whether to delete or not.

    Do you have any tips for how to start solving it?

    • Diedit oleh Marcoperry Sabtu, 01 Desember 2018 01.13
    Sabtu, 01 Desember 2018 00.55
  • Marcoperry,

    I'm not sure how your "imagine a tool" works but that sounds like the macro you wanted to write and as both Tom and I noted, that is not a trivial endeavor.

    Several years ago, (circa 2001), former Project MVP Jack Dahlgren wrote a macro called "Trace". With it a user can select a given task and trace it's predecessors, successors, or both. With a little work you may find it useful to set up a split screen with the same file in both panes. Select a task in the upper pane with a suspected redundant link chain and run the macro (predecessors). Then select the first predecessor of that same task in the lower pane and run the macro again. If both panes show a filtered set with a common set of tasks, you know you have redundancy and can flag it accordingly. Yes, it would be a tedious process but it might just be worth a try.

    Although I have Jack's macro myself I'm not allowed to share it directly, but fortunately I did find a website where you can get the macro. Take a look at:

    http://www.pragmaticpmo.com/trace-predecessors-and-successors-in-ms-project/

    John

    Sabtu, 01 Desember 2018 16.52
  • Thanks for the advice, but I must at least try to achieve the result.
    For this purpose I tried to proceed with my idea and I managed to make a code that seems to work but in the case of many activities it is very slow.
    I believe it must be optimized.
    What do you think of the code?

    Marco

    Sub Rendondant()
    Dim MyXL As Object
    Dim t As Task
    Dim Path() As Variant
    Dim Flag() As Boolean
    Dim Result()
    Dim i As Integer, j As Integer, k As Double
       ' Start => Find all possible routes and store in Path()
       ReDim Flag(1 To ActiveProject.Tasks.Count)
       For Each t In ActiveProject.Tasks
          If Not Flag(t.ID) Then
             If Not t.Summary Or (t.Summary And t.SuccessorTasks.Count > 0) Then
                Call Street(t, "", Path, Flag)
             End If
          End If
       Next t
       ' End -------------------------------------------------
       
       Stop
       
       'Start Look for double crossings
       For i = 1 To UBound(Path) - 1
          For j = i + 1 To UBound(Path)
             Call CheckCandidate(Path(i), Path(j), Result)
             DoEvents
          Next j
          Debug.Print i, j
       Next i
       ' End --------------------------
       Stop
       For i = 1 To UBound(Result, 2)
          Debug.Print Result(1, i) & "-" & Result(2, i)
       Next
       Stop
    End Sub
    
    Function Street(ByRef t As Task, ByVal Percorso As String, Path, Flag() As Boolean) As String
    Dim kid As Task, tmp As String, a, b, i As Integer
       Flag(t.ID) = True
       tmp = Percorso & IIf(Percorso = "", "", ",") & t.ID
       If t.SuccessorTasks.Count = 0 Then
          a = Split(tmp, ",")
          ReDim b(1 To UBound(a) + 1)
          For i = 0 To UBound(a)
             b(i + 1) = a(i) * 1
          Next i
          On Error Resume Next
          i = UBound(Path)
          If Err Then i = 0
          On Error GoTo 0
          ReDim Preserve Path(1 To i + 1)
          Path(UBound(Path)) = b
       Else
          For Each kid In t.SuccessorTasks
             Street = Street(kid, tmp, Path, Flag)
             DoEvents
          Next kid
       End If
    End Function
    
    Sub CheckCandidate(a, b, Result)
    Dim aStart As Integer, aFinish As Integer, bStart As Integer, bFinish As Integer
    Dim i As Integer, j As Integer, k As Integer
    Dim SameRoute As Boolean, Candidate As Boolean
       On Error GoTo EmptyArray
       aFinish = UBound(a): bFinish = UBound(b)
       On Error GoTo 0
       Do While True
          For i = 1 To aFinish
             For j = 1 To bFinish
                If a(i) = b(j) Then
                   SameRoute = True
                   Exit Do
                End If
             Next j
          Next i
          Exit Do
       Loop
       Do While SameRoute
          If a(i) <> b(j) Then
             SameRoute = False
             Exit Do
          End If
          i = i + 1: j = j + 1
          If i > aFinish Or j > bFinish Then
             On Error GoTo 0
             Exit Sub
          End If
       Loop
       For aStart = i To aFinish
          For bStart = j To bFinish
             If a(aStart) = b(bStart) Then
                On Error Resume Next
                k = UBound(Result, 2)
                If Err Then k = 0
                On Error GoTo 0
                If k = 0 Then
                   ReDim Result(1 To 2, 1 To 1)
                   Result(1, 1) = a(aStart)
                   Result(2, 1) = a(i - 1)
                Else
                   For k = 1 To UBound(Result, 2)
                      If Result(1, k) = a(aStart) Then Exit For
                   Next k
                   If k > UBound(Result, 2) Then
                      k = UBound(Result, 2)
                      ReDim Preserve Result(1 To 2, 1 To k + 1)
                      Result(1, k + 1) = a(aStart)
                      Result(2, k + 1) = a(i - 1)
                   End If
                End If
                Exit Sub
             End If
             DoEvents
          Next bStart
       Next aStart
    EmptyArray:
       On Error GoTo 0
    End Sub


    • Diedit oleh Marcoperry Senin, 03 Desember 2018 14.32
    Senin, 03 Desember 2018 14.08
  • Marco,

    Your code would be a bit easier to review if you included more comments describing the methods of each block as well as the overall methodology.

    Generally it appears to be a good first attempt.  I haven't looked in detail, but here are some obvious observations:

    1. The focus on string comparisons is not how I would have proceeded, though I can't point to anything obviously wrong with it.  (My path analyses are always based on the dependency objects, not the lists.)
    2. Perhaps I missed it, but I didn't see any obvious recursion.  My gut feel is that using multiple string arrays instead of recursion may be less efficient, and that's contributing to your long analysis times. (Note: recursion is the simple technique of having a procedure call a new instance of itself.  The original Trace macro that John pointed to uses recursion, as do other network tracers like the free macros on my company's website.)
    3. I don't understand why Street is a function rather than a sub, but I guess vba doesn't enforce the difference between the two.
    4. I'm not sure your routine will catch the subtle differences associated with non-FS relationships, leads, and lags.  In such cases, the "redundancy" depends on mathematical rather than string comparisons.

    Good luck, tom

    Senin, 03 Desember 2018 16.04
  • In reality yes, the first part is recursive. I enclose the comments on the code.

    The problem is that the number of possible routes is exponential with respect to the number of Gantt activities
     - 125 activities => ~ 400 possible paths 
     - 1500 activities => ~ 180000 possible paths
    This means an array of 180000 arrays and the calculation time becomes days

    Marco

    Sub Rendondant() Dim MyXL As Object Dim t As Task Dim Path() As Variant Dim Flag() As Boolean Dim Result() Dim i As Double, j As Double, k As Double 'Start => Find all possible routes and store in Path() 'Street is a recursive function 'The goal is to have an array of arrays that contains all the possible paths. Saved 1 for each record. 'The result will be found in Path() ReDim Flag(1 To ActiveProject.Tasks.Count) For Each t In ActiveProject.Tasks If Not Flag(t.ID) Then If Not t.Summary Or (t.Summary And t.SuccessorTasks.Count > 0) Then Call Street(t, "", Path, Flag) End If End If Next t ' End ------------------------------------------------- Stop 'Start Look for double crossings 'If there is a double cross there could be redundancy. This is a candidate 'Check Path (1 with 3), (1 with 4), (1 with n) ' (2 with 4), (2 with 5), (1 with n) ' (........), (........), (........) ' (n-3 with n-2), (n-3 with n-1), (n-3 with n) ' (n-2 with n-1), (n-2 with n) ' (n-1 with n) For i = 1 To UBound(Path) - 1 For j = i + 1 To UBound(Path) Call CheckCandidate(Path(i), Path(j), Result) DoEvents Next j Debug.Print i, j Next i ' End -------------------------- Stop For i = 1 To UBound(Result, 2) Debug.Print Result(1, i) & "-" & Result(2, i) Next Stop End Sub Function Street(ByRef t As Task, ByVal Percorso As String, Path, Flag() As Boolean) As String Dim kid As Task, tmp As String, a, b, i As Double Flag(t.ID) = True tmp = Percorso & IIf(Percorso = "", "", ",") & t.ID 'During the search the path is saved in a comma-separated string. 'This is because the variable used with ByVal retains its value according to nesting If t.SuccessorTasks.Count = 0 Then 'There are no more successors so the end of a possible path has been reached 'The string is transformed into an array of strings (a) and finally into an array of numbers (b) index 1..n a = Split(tmp, ",") ReDim b(1 To UBound(a) + 1) For i = 0 To UBound(a) b(i + 1) = a(i) * 1 Next i On Error Resume Next 'If the array is empty generate an error i = UBound(Path) If Err Then i = 0 On Error GoTo 0 'For debug If i / 1000 = Int(i / 1000) Then Debug.Print i 'Add a record in the main array and store the new found path ReDim Preserve Path(1 To i + 1) Path(UBound(Path)) = b Else For Each kid In t.SuccessorTasks Street = Street(kid, tmp, Path, Flag) 'Recoursive Call DoEvents Next kid End If End Function Sub CheckCandidate(a, b, Result) Dim aStart As Integer, aFinish As Integer, bStart As Integer, bFinish As Integer Dim i As Integer, j As Integer, k As Integer Dim SameRoute As Boolean, Candidate As Boolean On Error GoTo EmptyArray aFinish = UBound(a): bFinish = UBound(b) On Error GoTo 0 'Search for the first intersection (the same activity in the two arrays) 'SameRoute = True Do While True For i = 1 To aFinish For j = 1 To bFinish If a(i) = b(j) Then SameRoute = True Exit Do End If Next j Next i Exit Do Loop 'Increase i and j until cha a (i) and a (j) are different Do While SameRoute If a(i) <> b(j) Then SameRoute = False Exit Do End If i = i + 1: j = j + 1 If i > aFinish Or j > bFinish Then On Error GoTo 0 Exit Sub End If Loop 'If it has found the first intersection, check for a second one 'Search only for the remainder of the routes a and b For aStart = i To aFinish For bStart = j To bFinish 'Save a new candidate only if one has not already been saved If a(aStart) = b(bStart) Then On Error Resume Next k = UBound(Result, 2) If Err Then k = 0 On Error GoTo 0 If k = 0 Then ReDim Result(1 To 2, 1 To 1) Result(1, 1) = a(aStart) Result(2, 1) = a(i - 1) 'For the Debug, the number of intersections found Debug.Print "1 ------------------------------" Else For k = 1 To UBound(Result, 2) If Result(1, k) = a(aStart) Then Exit For Next k If k > UBound(Result, 2) Then k = UBound(Result, 2) 'For the Debug, the number of intersections found Debug.Print k + 1 & "-------------------------------" ReDim Preserve Result(1 To 2, 1 To k + 1) Result(1, k + 1) = a(aStart) Result(2, k + 1) = a(i - 1) End If End If Exit Sub End If DoEvents Next bStart Next aStart EmptyArray: On Error GoTo 0 End Sub

    • Diedit oleh Marcoperry Selasa, 04 Desember 2018 12.29
    Selasa, 04 Desember 2018 11.10
  • Marco,

    Yep, I had missed the recursive call in Street.  Unfortunately, it appears that you are re-exploring the same path segments many times (through the unrestricted recursion as well as the "For each t" block in Redondant.)  I think you need to add some conditions to prevent that, e.g. mark the path segments that you have already explored, then abort further Street calls if this mark is present.

    Ultimately, the last concern of my earlier response is still pretty major:  your paths are constructed by ignoring all dependency information (e.g. link-types, lag-types, lag values). Such an algorithm would generate numerous false-positives in most real-world schedules - not very useful for general-purpose analyses in my opinion.

    In any case, the search for redundant logic remains a "tall order" (funny that John and I used that expression independently in our initial responses.)  The arrays needed for a comprehensive analysis can get big, and I'd expect a substantial computation time requirement no matter what improvements you make.

    Good luck, tom

    Selasa, 04 Desember 2018 17.36
  • Marcoperry,

    Although it looks like you are having a whole lot of fun working on this tall order, are you sure your time wouldn't be better spend visually perusing through the file and finding the most likely candidates, marking them with a flag and then go back and task whatever action is appropriate?

    I didn't study your code in detail but a couple of comments are in order. What are you doing with the MyXL object? Answer, nothing. One of the first things I do when setting up a macro is to include an Option Explicit statement. That tells me if I miss a declaration and also helps me to go back and delete declarations that are "redundant".

    Also, why do you use the DoEvents statement (3 times)? I see nothing in your code that benefits from their use and in fact could slow down processing depending on what else is going on in your system.

    My two cents.

    John

    Rabu, 05 Desember 2018 01.45
  • Tom and John thank you for the answers.
    I used the MyXL variable to analyze the data in Excel and evaluate a better algorithm to avoid exploring the same path over and over again. Each path is different.
    Regarding the type of relationship / lag surely will have to be considered.
    At the moment I would like to check the number of results and in the case of a few results, visual analysis will be simple
    If I set a flag in a task in order not to analyze it again I lose all the successors that start from it.
    To respond to John: Surely you're right but I have to analyze several projects and have a report of possible redundancies obliges me to spend my time in this "tall order"
    Regarding DoEvents, I have included these instructions to stop the calculation. If VBA is engaged in a For ... Next very long I should stop the process
    Rabu, 05 Desember 2018 16.24
  • Marcoperry,

    You're welcome and thanks for the feedback.

    Yeah I though you may have used Excel to help with the analysis but it wasn't obvious from your posted code.

    It sounds like you are having "fun" figuring out how to best approach the issue. From our discussion thus far I'm confident you will come up with something of use to you and for that, I wish you good luck.

    John

    Kamis, 06 Desember 2018 16.06