none
Need help getting a date range RRS feed

  • Question

  • I am writing a Macro in MS Project to highlight the tasks that are scheduled to be completed in the next two weeks.  I am able to get the beginning and ending dates for the upcoming two week period (today is Mar 28, 2017 therefore the upcoming two week period is Mar 28 – April 11).  This is confirmed with a message box.    The current code I have highlights tasks that are not 100% complete and are scheduled to be complete after April 1. 

    I could use some help creating the date range.

    +++++++++++++++++++++++++++++++++++++++++++++++++++++++

    Sub HighlightTwoWksPost()

    ' Highlight due in next two weeks

    Dim T As Task

    ' Dim SubProjId As Long - subproject removal testing 3/20/17 rlh

    Dim TskSub As Task

    'Get todays date

    ' Calculate date paramaters

    Dim Today

    Today = Date

    '   Two Weeks

    Dim TwoWeeksB As Date

    Dim TwoWeeksE As Date

    '2 Weeks

    ' Tomorrow through Today plus 14

    TwoWeeksB = DateAdd("D", 1, Today)

    TwoWeeksE = DateAdd("D", 14, Today)

    'MsgBox ("Two Weeks Start Date:  " & (TwoWeeksB))

    'MsgBox ("Two Weeks End Date:  " & (TwoWeeksE))

    MsgBox ("Two Week Range : " & (TwoWeeksB) & ": - " & (TwoWeeksE))

     'Show all Sub-tasks

        SelectSheet

        OutlineShowAllTasks

        For Each T In ActiveProject.Tasks

            If Not T Is Nothing Then

                If T.Subproject <> "" Then

                    SubProjId = T.ID

                ElseIf Not T.Summary Then

                    SelectRow Row:=SubProjId + T.ID, rowrelative:=False

          

           Complete = Names & T.PercentComplete

       '    MsgBox Complete

           Names = Names & T.Finish

               

        ' test if task is 100% complete first and if so skip to next task on gant chart

           If T.PercentComplete <> 100 Then

                   

          

     '  If TwoWeeksB < T.Finish > TwoWeeksE Then

       If T.Finish <= TwoWeeksB And T.Finish >= TwoWeeksE Then

      ' If T.Finish > TwoWeeksE Then

      

     

    'If T.Finish < TwoWeeksB And T.Finish > TwoWeeksE Then

                     Font32Ex CellColor:=49407

                  '  Font32Ex Color:=2366701

              '   Else: Continue = True

               '  End If

      End If

                   Names = ""

               

                  End If

            End If

       

          End If

        Next T

        EditGoTo ID:=1

       

        ' add a message to user that highlighting is done

     MsgBox ("Agent is complete")

    End Sub

    Tuesday, March 28, 2017 6:43 PM

All replies

  • Rob,

    It looks like you intend (or intended) to run your macro on a dynamic master file. Is that the case? If so you need to be aware that if you use the construct For Each T in ActiveProject.Tasks, it will only loop through the summary line insertion points of each subproject. Why? Because the subproject tasks are not actually part of the master, rather the master contains pointers to each individual subproject. In order to cycle through ALL tasks shown at master level the following construct is needed.

    For Each T in ActiveProject.Subprojects(index).SourceProject.Tasks

    where "index" is the reference for each subproject (i.e. 1, 2, etc.)

    Or, you could use foreground processing by selecting all tasks and then looping through the ActiveSelection.Tasks.

    However, to do what you want I suggest you create a custom filter using the FilterEdit Method to define the two week period and tasks that are less than 100% complete, apply that to the file, select that filtered set and then apply the Font32EX Method. When the filter is removed, all the selected tasks will be highlighted. For help in creating the custom filter, record a macro of you doing it manually and then use that in your macro code.

    You will be able to accomplish what you want with a whole lot less lines of code and it will work with a single file, or a linked structure such as a dynamic master.

    Hope this helps.

    John

    Tuesday, March 28, 2017 8:47 PM