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.
Originally Posted by kre30a
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
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
Reply With Quote
