none
Conditional Formatting MS Project based on Resource column

    Question

  • Hi, hope someone can help with this one 

    Looking to colour the entire row when the resource column contains the phrase 'Maint' so it will therefore pick up Maint1, Maint2, Maint3, etc. Basically, to do on Project what conditional formatting could do on Excel. I would like to be able to just run a macro that would automatically check and carry out this action based on these settings

    I know this can probably be done via a macro, but have tried several i've found around the net and can't get anything to work, sadly i'm not a programming guru! Would really appreciate if anyone could advise

    Wednesday, February 13, 2013 10:45 PM

Answers

  • Hi,

    Here's a competed code (finding a piece of text in the Text11 field for instance)

    Sub colormaint()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count

    SelectRow 1, False

    FontEx CellColor:=pjWhite
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjBlue
    End If
    If InStr(LCase(ActiveSelection.Tasks(1).Text11), "apiece") Then
    FontEx CellColor:=yellow
    End If

    For Ctr = 2 To Lines
    SelectRow 1, True
    FontEx CellColor:=pjWhite
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjBlue
    End If
    If InStr(LCase(ActiveSelection.Tasks(1).Text11), "apiece") Then
    FontEx CellColor:=yellow
    End If
    Next Ctr
    End Sub

     

    Greetings,

    Thursday, February 21, 2013 4:47 PM
    Moderator

All replies

  • Hi,

    This will hopefully work:

    Sub colormaint()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count
    SelectRow 1
    For Ctr = 2 To Lines - 1
    SelectRow 1, True
    If InStr(ActiveSelection.Tasks(1).ResourceNames, "Maint") Then
    FontEx CellColor:=pjYellow
    Else
    FontEx CellColor:=pjWhite
    End If
    Next Ctr
    End Sub

     There are instructions on how to implement a VBA procedure in www.masamiki.com

    The procedure may not work when there are empty lines in the view.

    Greetings,

    Thursday, February 14, 2013 5:05 PM
    Moderator
  • Jan,

    Thank you so much for the help, very much appreciated. It works great, with only one slight issue i noticed.

    I quickly knocked up a row of ten tasks, mixed up resources, etc, and when i ran the macro it coloured in every one of them perfectly, with the exception of Row 1. Any thoughts?

    Many thanks,

    James

    Thursday, February 14, 2013 9:07 PM
  • James,

    This revised version of Jan's macro fixes the row 1 issue. I also added the Option Compare Text to avoid having to worry about whether the resources are named "Maint1" or "maint1" (i.e. case insensitive)

    Option Compare Text
    Sub colormaint()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count
    SelectRow row = 1, rowrelative = False
    For Ctr = 2 To Lines - 1
    SelectRow 1, True
    If InStr(ActiveSelection.Tasks(1).ResourceNames, "Maint") Then
    FontEx CellColor:=pjYellow
    Else
    FontEx CellColor:=pjWhite
    End If
    Next Ctr
    End Sub

    John

    Friday, February 15, 2013 2:14 AM
  • John,

    Thanks for that, works great apart from one little glitch. I notice that when i run it, it picks up everything that matches the 'Maint' condition (i actually colour the ones that don't match Maint a light blue) with the exception of the first and last on my list of tasks. If i filter the non-Maint tasks, the first and last ones don't get highlighted, and i can't think why this is happening? Basically, the revised code is this:

    Sub CondFormat()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count
    SelectRow Row = 1, rowrelative = False
    For Ctr = 2 To Lines - 1
    SelectRow 1, True
    If InStr(ActiveSelection.Tasks(1).ResourceNames, "MAINT") Then
    FontEx CellColor:=pjWhite
    Else
    Font32Ex CellColor:=15784390
    End If
    Next Ctr
    End Sub

    Also, if i wanted to have two conditions (for example a different colour based on wording in a different column) can i insert an additional line, or do i just create a second For Next loop?

    Many thanks for your help, much appreciated

    Friday, February 15, 2013 10:13 AM
  • Hi,

    This version colors also lines 1 and the last one; also it takes upper case problems into account:

    Sub colormaint()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count

    SelectRow 1, False
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjYellow
    Else
    FontEx CellColor:=pjWhite
    End If
    For Ctr = 2 To Lines
    SelectRow 1, True
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjYellow
    Else
    FontEx CellColor:=pjWhite
    End If
    Next Ctr
    End Sub

    As for extending the macro, you better code other conditions within the same loop. It may be much more than a single line, though.

    Greetings,

    Friday, February 15, 2013 11:12 AM
    Moderator
  • Jan,

    Many thanks for that, that code works perfectly, very much appreciated

    I have tried unsuccessfully to add in an additional condition but have so far failed, i will keep trying though! I guess what i want is along the lines of:

    If (condition 1) then blue

    If (condition 2) then yellow

    ELSE white 

    The second condition would be looking at a piece of text in a different column, not resource 

    Thursday, February 21, 2013 4:34 PM
  • Hi,

    Here's a competed code (finding a piece of text in the Text11 field for instance)

    Sub colormaint()
    OutlineShowAllTasks
    FilterApply "All Tasks"
    SelectAll
    Lines = ActiveSelection.Tasks.Count

    SelectRow 1, False

    FontEx CellColor:=pjWhite
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjBlue
    End If
    If InStr(LCase(ActiveSelection.Tasks(1).Text11), "apiece") Then
    FontEx CellColor:=yellow
    End If

    For Ctr = 2 To Lines
    SelectRow 1, True
    FontEx CellColor:=pjWhite
    If InStr(LCase(ActiveSelection.Tasks(1).ResourceNames), "maint") Then
    FontEx CellColor:=pjBlue
    End If
    If InStr(LCase(ActiveSelection.Tasks(1).Text11), "apiece") Then
    FontEx CellColor:=yellow
    End If
    Next Ctr
    End Sub

     

    Greetings,

    Thursday, February 21, 2013 4:47 PM
    Moderator
  • Jan,

    Thanks again for your help, greatly appreciated

    Can i pester you with a couple of final questions?

    1) In the first query (the resource names) is it possible to use the InStr in reverse, by that i mean colour it blue when the field doesn't equal 'Maint' ... it's not an issue as i can just reverse the colours but it was just a curiosity of mine! 

    2) in the second query, can you look at two pieces of info in one string ... for example could i look for the words 'Thorough' and 'Intermediate' in one string? 

    Many thanks,

    James

    Thursday, February 21, 2013 8:13 PM
  • Hi,

    1) Yes, here are two ways:

    If not Instr(....) then

    If Instr(....)=0 then

    2) If (Instr(...,"Thorough")) and (Instr(...., "Intermediate")) Then

    You can imagine the alternative with Or instead of And

    Greetings,

    Thursday, February 21, 2013 10:05 PM
    Moderator
  • Jan,

    Many thanks again, i've made some tweaks to suit my sheet and it works perfectly, i really do appreciate the help you've given

    Can i just ask a final question .... if at some point i wanted to just colour the cell that contained the word for each selected row, not the entire row, could that be done?

    Tuesday, February 26, 2013 8:48 AM
  • Hi,

    Possible but hen you better copy and make a different version of the code

    You have to know the position of the cell (column number fi you like). Suppose it is 8

    Replace selectrow 1, False    by SelectCell 1,8,False

    and replace Selectrow 1,True by Selectcelldown

    Greetings,

    Tuesday, February 26, 2013 3:28 PM
    Moderator