none
Code to expand / show all subtasks under a summary group while in a filtered view RRS feed

  • General discussion

  • Moving this from Project Forums  >  Project Standard and Professional General Questions and Answers at the recommendation of a more experienced group member. - jd

    I've posted the code under an older question (in the above referenced forum) regarding this topic. Posting anew in the interest of getting feedback on how to improve my code, better approaches, different objects, methods, properties, events, etc. which might make this work better.

    This partially restores a feature that did not make it to 2010. Not sure if it's back in 2013.

    That feature allowed you to:

    •Collapse a summary task by double clicking on the expand / collapse control while in a filtered view
    •Expand the group again showing all the sub tasks only under that summary tasks
    •Leave the rest of the project filtered

    I've only been working with this code for a day or so. I would not consider it fully tested. So far so good.

    Thanks,

    John

    ------------- Here's the code for expanding the summary group -----------------------------------------------------

        Option Explicit
        Sub modShowFilteredSubTasks()
       
        'Need to handle case of "All Tasks" being the filter
        'Does not work with the auto filters, how to do that ... ???
       
        Dim flFilter As Filter
        Dim slSelectionX As Selection
        Dim strFilterName As String
        Dim strWBS As String
        Dim strTmpFltrNm As String 'for the temp filter name
        Dim lngRowX As Long
        Dim tfOK As Boolean
        Dim docPropsX As Office.DocumentProperties
        Dim docPropX As Office.DocumentProperty
        Dim numPropsX As Integer
       
       
       
        'initialize variables & objects
        strTmpFltrNm = "ShowSubTasks"
        Set slSelectionX = Application.ActiveSelection
        Set docPropsX = ActiveProject.CustomDocumentProperties
       
        If ActiveProject.CurrentFilter = strTmpFltrNm Then 'means this is a second pass with same filter
           For Each docPropX In docPropsX
              If (docPropX.Name = "Last Filter") Then
                 strFilterName = docPropX.Value
                    'see if the temp filter is still there and delete it if so.
                 For Each flFilter In ActiveProject.TaskFilters
                     If flFilter.Name = strTmpFltrNm Then
                         Application.OrganizerDeleteItem Type:=pjFilters, FileName:=ActiveProject.FullName, Name:=strTmpFltrNm
                     End If
                 Next flFilter
                 Set flFilter = ActiveProject.TaskFilters.Copy(strFilterName, strTmpFltrNm)
                 flFilter.Apply 'reset filter to previous filter
              End If
           Next docPropX
        Else 'first pass with selected filter
           strFilterName = ActiveProject.CurrentFilter
           'see if the temp filter is still there and delete it if so.
           For Each flFilter In ActiveProject.TaskFilters
               If flFilter.Name = strTmpFltrNm Then
                   Application.OrganizerDeleteItem Type:=pjFilters, FileName:=ActiveProject.FullName, Name:=strTmpFltrNm
               End If
           Next flFilter
           Set flFilter = ActiveProject.TaskFilters.Copy(strFilterName, strTmpFltrNm)
           'use a custom document property to store the current filter name
           For Each docPropX In docPropsX
              If (docPropX.Name = "Last Filter") Then
                 docPropX.Value = ActiveProject.CurrentFilter
              End If
           Next docPropX
        End If
       
        If strFilterName = "All Tasks" Then
            MsgBox ("A filter must be active." & vbCrLf & _
                    "Please select a filter on the View tab," & vbCrLf & _
                    "then try again")
            Exit Sub
        End If
       
       
           
        'save where we are now so we can get back there
        lngRowX = slSelectionX.Tasks(1).ID
       
        'Debug.Print (strFilterName)
        
        strWBS = slSelectionX.Tasks.Item(1).WBS
        If slSelectionX.Tasks(1).OutlineLevel <> 1 Then
           strWBS = Mid(strWBS, 1, Len(strWBS) - 2)
        End If
       
        'add an or condition to the temp filter to show tasks in the WBS grouping
        FilterEdit Name:=strTmpFltrNm, _
            TaskFilter:=True, _
            Parenthesis:=True, _
            FieldName:="", _
            NewFieldName:="WBS", _
            Test:="equals", _
            Value:=strWBS & "*", _
            Operation:="Or", _
            ShowSummaryTasks:=True, _
            ShowInMenu:=False
           
        For Each flFilter In ActiveProject.TaskFilters
           If flFilter.Name = strTmpFltrNm Then
              flFilter.Apply
              Exit For
           End If
        Next flFilter   
       
        'now go back to where we started else Project dumps you at row one
        tfOK = Application.FindEx(Field:="ID", Value:=lngRowX, Test:="Equals")
       
        'Clean this mess up!
        Set flFilter = Nothing
        Set slSelectionX = Nothing
       
        End Sub


    JPD44

    Monday, July 1, 2013 4:39 PM