Export Hanging Dependencies in MS Project [Project - VBA]

Working with Microsoft Project and looking for ways to discover poor network logic?  Below is a little procedure I wrote that scans the relationships in your project schedule in search of tasks with only Start-To-Start (SS) successors.

If the procedure finds any tasks that meet this criteria it exports information about the task to an Excel workbook for further analysis.

Why are SS-only successors bad?  They create poor network logic: Without at least one FS successor the Task will not accurately push schedule milestones and tasks further down the path.

What's an easy way to fix SS-only successor relationships?  Link the offending task to a milestone (or another task) further down the path with a Finish-To-Start (FS) relationship.

Quick notes:

1. You'll want to change the Constant consMinInDay depending on how many hours you have scheduled in your workday (in the example code consMinInDay is set to 480 minutes.  I have 8hr days X 60min = 480min/d).  
2. Despite how you may view the data in the Project, the application stores the data (or at least VBA exports the data) in minutes.
3. If your Project file is not already referenced to Excel, you'll need to set this reference in the VBA editor.  
1. To set the Excel reference: Open up the VBA Editor, Alt-F11>Tools>References>Check Microsoft Excel X.0.  The "X" will be the version number of Excel installed on your computer.  E.g. Excel 2007 = 12.0; Excel 2010 = 14.0.
4. I haven't tested the procedure in Project 2010, but running it in MSP2003 and MSP2007 should work without a problem.

Sub Hanging_Deps()
    Dim TaskDep As TaskDependency
    Dim ts As Tasks
    Dim t As Task
    Dim y As Long
    Dim xlApp As Excel.Application
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim bTaskDepSucc As Boolean

    Const consMinInDay As Long = 480
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Workbooks.Add
    Set wb = xlApp.ActiveWorkbook
    Set ws = wb.ActiveSheet
    xlApp.Visible = True
    ws.Cells(1, 1) = "Task UID"
    ws.Cells(1, 2) = "Task ID"
    ws.Cells(1, 3) = "Task Name"
    ws.Cells(1, 4) = "Task Pct Complete"
    ws.Cells(1, 5) = "Task Succs"
    ws.Cells(1, 6) = "Task Finish"
    ws.Cells(1, 7) = "Succ UID"
    ws.Cells(1, 8) = "Succ ID"
    ws.Cells(1, 9) = "Succ Name"
    ws.Cells(1, 10) = "Succ Type"
    ws.Cells(1, 11) = "Succ Lag"
    ws.Cells(1, 12) = "Succ Pct Complete"
    ws.Cells(1, 13) = "Succ Start"
    y = 2
    
    WindowActivate TopPane:=True
    FilterApply Name:="All tasks"
    GroupApply Name:="No Group"
    SelectSheet
    Set ts = ActiveSelection.Tasks
    For Each t In ts
        If (Not t Is Nothing) And (Not t.ExternalTask) And (Not t.Summary) _
                And t.ActualFinish = "NA" And InStr(1, t.UniqueIDSuccessors, "SS") > 0 Then
            bTaskDepSucc = False
            For Each TaskDep In t.TaskDependencies
                If t.UniqueID = TaskDep.From Then
                    If TaskDep.Type = 3 Then
                        bTaskDepSucc = True
                    Else
                        bTaskDepSucc = False
                        Exit For
                    End If
                End If
            Next TaskDep
            If bTaskDepSucc Then
                For Each TaskDep In t.TaskDependencies
                    If t.UniqueID = TaskDep.From Then
                        ws.Cells(y, 1) = t.UniqueID
                        ws.Cells(y, 2) = t.id
                        ws.Cells(y, 3) = t.Name
                        ws.Cells(y, 4) = t.PercentComplete
                        ws.Cells(y, 5).NumberFormat = "@"
                        ws.Cells(y, 5) = t.UniqueIDSuccessors
                        ws.Cells(y, 6) = Format(t.Finish, "mm/dd/yyyy")
                        ws.Cells(y, 7) = TaskDep.To.UniqueID
                        ws.Cells(y, 8) = TaskDep.To.id
                        ws.Cells(y, 9) = TaskDep.To.Name
                        Select Case TaskDep.Type
                            Case 0
                                ws.Cells(y, 10) = "FF"
                            Case 1
                                ws.Cells(y, 10) = "FS"
                            Case 2
                                ws.Cells(y, 10) = "SF"
                            Case 3
                                ws.Cells(y, 10) = "SS"
                        End Select
                        ws.Cells(y, 11) = TaskDep.lag / consMinInDay
                        ws.Cells(y, 12) = TaskDep.To.PercentComplete
                        ws.Cells(y, 13) = Format(TaskDep.To.Start, "mm/dd/yyyy")
                        y = y   1
                    End If
                Next TaskDep
            End If
        End If
    Next t
End Sub

Bear out.