Consulting

Results 1 to 4 of 4

Thread: Color code entire task row based on text in a certain column

  1. #1

    Color code entire task row based on text in a certain column

    MS Project:

    I have a current project plan with multiple tasks. I would like to know if there is a VBA solution to color code the entire row of a task based on the text in the status column.

    If the status is "Complete", the row will be blue. If the status is "On Schedule", the status will be green. If the status is "Late", the row will be red. If the status is "Future Task", the row will be white.

  2. #2
    Quote Originally Posted by kre30a View Post
    MS Project:

    I have a current project plan with multiple tasks. I would like to know if there is a VBA solution to color code the entire row of a task based on the text in the status column.

    If the status is "Complete", the row will be blue. If the status is "On Schedule", the status will be green. If the status is "Late", the row will be red. If the status is "Future Task", the row will be white.

  3. #3
    I am working on a similar type of Macro. I see your post is from 2016. Were you ever able to get this code completed? I am working on developing similar code. I have it started, but have a ways to go. My code loops through and highlights the past due tasks and sets the text to red. I also look at the %Complete value in the Gant Chart. I will next be working on highlighting the tasks that are due in the next two weeks, month and three months. I am working on creating the date range (two weeks March 17 - March 30) and then highlighting those tasks a different color.
    If you have had luck, would you mind sharing your code? Thank you

  4. #4
    Sorry, I forgot the code. This is what I have now, and it gets the dates (and highlights everything from the two week start date going forward). I am not sure how to incorporate the two week end date. Your help would be greatly appreciated!

    Sub HighlightTwoWks()
    ' 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 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

    ' message to user that highlighting is done

    MsgBox ("Agent is complete")
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •