locked
MS Project Standard 2013: ActiveCell.CellColor Issues RRS feed

  • Question

  • Hi there.

    I am currently working on a VBA macro in MS Project Standard 2013.  I am attempting to create code for a sort of conditional formatting, which will color cells depending on the text inside of them.

    I was able to get the code to work using "Font32Ex CellColor:=". However, when the macro is ran, it is way too slow.  

         Font32Ex Code:

              SelectTaskCell Row:=taskProjTask.ID, Column:="Text1", RowRelative:= False

              Font32Ex CellColor:= 255

    So, I switched to using "ActiveCell.CellColor =". This worked great...until it only ran through 40 rows...

         ActiveCell Code:

              SelectTaskCell Row:=taskProjTask.ID, Column:="Text1", RowRelative:= False

              ActiveCell.CellColor = pjRed

    I would like to use "ActiveCell" due to the amazing runtime. However, Run-time error '1004' occurs after 40 rows are cycled through.

    Do you have any advice? Hopefully I posted this in the right place. I have never posted in forums before.

    Any help would be appreciated! Thank you so much.

    Thursday, November 26, 2020 6:26 PM

Answers

  • Jake,

    Your example code doesn't quite gel, there is no "day" argument in the DateDiff function.

    Nonetheless, I ran this code on a sample file with 50 tasks. It populated the Text1 field for all tasks and it set the cell background color to red, no errors.

    Sub testformat()
    Dim t As Task
    For Each t In ActiveProject.Tasks
        If t.Start1 > ActiveProject.CurrentDate Then
            t.Text1 = DateDiff("d", ActiveProject.CurrentDate, t.Start1) & " days"
            SelectTaskCell Row:=t.ID, Column:="text1", rowrelative:=False
            ActiveCell.CellColor = pjRed
        End If
    Next t
    End Sub

    I can't help you if you don't give enough accurate information. Show me your full code.

    For reference, the filter I used to color the cell background for the first 4 outline levels is this: (The Flag13 is cleared for something else and not related to summary line background colors)

    For i = 1 To 4
            FilterEdit Name:="OLX", taskfilter:=True, Create:=True, OverwriteExisting:=True, _
                FieldName:="summary", test:="equals", Value:="yes", ShowInMenu:=False
            FilterEdit Name:="OLX", taskfilter:=True, Operation:="and", _
                NewFieldName:="outline level", test:="equals", Value:=CStr(i)
            FilterApply Name:="OLX"
            SelectAll
            If ActiveSelection > 0 Then
                For Each t In ActiveSelection.Tasks
                    If t.Flag13 = True Then t.Flag13 = False
                Next t
                NumTsk = ActiveSelection.Tasks.Count
                If i = 1 Then Font32Ex Color:=16777215, CellColor:=6299648 'dark blue with white font
                If i = 2 Then Font32Ex CellColor:=12611584  'blue
                If i = 3 Then Font32Ex CellColor:=15773696  'light blue
                If i = 4 Then Font32Ex CellColor:=15853019  '80% blue
            Else
                Exit For
            End If
        Next i

    Another item to note. The ActiveCell.CellColor Method only works on one cell at a time whereas the Font32Ex Method can be used to format multiple cells at once.

    John



    • Edited by John - Project Saturday, November 28, 2020 5:16 PM more info
    • Marked as answer by xJake007x Wednesday, December 2, 2020 1:06 AM
    Saturday, November 28, 2020 2:24 AM

All replies

  • xjake007x,

    Although this isn't the Project customizing and programming forum, it's close enough for your question.

    I had to smile when I read your "amazing runtime". Unlike Excel, and perhaps other Office apps, Project doesn't allow direct access to objects for formatting, (background processing), so the only method available requires working with selected objects (foreground processing) and that is generally always slower because of the screen updating overhead. If you could work directly with Project objects for formatting, then you'd see what "amazing runtime" really is.

    Okay, back to our story. First of all, when forced to use foreground processing, if at all possible I first apply a filter to isolate just those lines that are applicable to what I want to do. Then I do a mass format on the ActiveSelection. That speeds things up compared to selecting view objects one by one. Matter of fact I recently wrote a macro for someone wherein he wanted to format the cell color of various outline level tasks in different colors and I used filters to do that en-mass. For reference I used the Font32Ex style code. Would the ActiveCell.CellColor run faster? I don't know, maybe I'll try it.

    As far as your runtime error 1004, that generally occurs because the code has hit something it can't resolve, like addressing an object that is not defined. You don't say how you set up the loop to set the cell color so I really can' tell you why it erred after 40 rows. If you give us more details perhaps I can give more insight. But try the filter approach first and see if that gets you what you want.

    Hope this helps.

    John

    Thursday, November 26, 2020 7:43 PM
  • John, 

    Thank you for your reply!

    You are absolutely correct. "Amazing runtime" is probably not the best choice of words for Project :)

    I find it a little strange how using "Font32Ex CellColor:=" cycles through every row, but as soon as I switch it to "ActiveCell.Cellcolor =", the script errors out after only 40 rows. (The rest of the code is kept the same.)

    Also, I realize that I misspoke in my earlier message.  The cell color does not depend directly on the text inside of the cell, but changes depending on conditions in different cells.

    For example:

         If tsk.Start1 > Now Then

              tsk.Text1 = DateDiff("day", CurrentDay, tsk.Start1) & " days"

              SelectTaskCell Row:=tsk.ID, Column="Text1", RowRelative:=False

              ActiveCell.CellColor = pjRed   '(originally "Font32Ex CellColor:=255")

    I can attempt to apply an isolating filter, but I am a little unsure how that will look, since the conditional is not directly dependent on the text in the cell that I wish to change (my apologies).

    If your macro formatting the cell color of various tasks was posted online, would you be willing to add the link?

    Thanks again for your help!

    Jake


    Friday, November 27, 2020 9:21 PM
  • Jake,

    Your example code doesn't quite gel, there is no "day" argument in the DateDiff function.

    Nonetheless, I ran this code on a sample file with 50 tasks. It populated the Text1 field for all tasks and it set the cell background color to red, no errors.

    Sub testformat()
    Dim t As Task
    For Each t In ActiveProject.Tasks
        If t.Start1 > ActiveProject.CurrentDate Then
            t.Text1 = DateDiff("d", ActiveProject.CurrentDate, t.Start1) & " days"
            SelectTaskCell Row:=t.ID, Column:="text1", rowrelative:=False
            ActiveCell.CellColor = pjRed
        End If
    Next t
    End Sub

    I can't help you if you don't give enough accurate information. Show me your full code.

    For reference, the filter I used to color the cell background for the first 4 outline levels is this: (The Flag13 is cleared for something else and not related to summary line background colors)

    For i = 1 To 4
            FilterEdit Name:="OLX", taskfilter:=True, Create:=True, OverwriteExisting:=True, _
                FieldName:="summary", test:="equals", Value:="yes", ShowInMenu:=False
            FilterEdit Name:="OLX", taskfilter:=True, Operation:="and", _
                NewFieldName:="outline level", test:="equals", Value:=CStr(i)
            FilterApply Name:="OLX"
            SelectAll
            If ActiveSelection > 0 Then
                For Each t In ActiveSelection.Tasks
                    If t.Flag13 = True Then t.Flag13 = False
                Next t
                NumTsk = ActiveSelection.Tasks.Count
                If i = 1 Then Font32Ex Color:=16777215, CellColor:=6299648 'dark blue with white font
                If i = 2 Then Font32Ex CellColor:=12611584  'blue
                If i = 3 Then Font32Ex CellColor:=15773696  'light blue
                If i = 4 Then Font32Ex CellColor:=15853019  '80% blue
            Else
                Exit For
            End If
        Next i

    Another item to note. The ActiveCell.CellColor Method only works on one cell at a time whereas the Font32Ex Method can be used to format multiple cells at once.

    John



    • Edited by John - Project Saturday, November 28, 2020 5:16 PM more info
    • Marked as answer by xJake007x Wednesday, December 2, 2020 1:06 AM
    Saturday, November 28, 2020 2:24 AM
  • John,

    Here is the code that I have been working with:

    Sub Conditional_Formatting_Macro()
        Dim t As Task
        Dim Days As Integer
        Days = 5 'Days Remaining
        For Each t In ActiveProject.Tasks
            t.Text1 = "" 'Clear Text1 Cells
            t.Text4 = "" 'Clear Text4 Cells
                    If (t.Name = "") Then
                        'Do nothing
                    ElseIf t.Start1 <> "N/A" Then
                        If t.Start2 = "N/A" Then
                            If t.Start1 < Now Then 'Late
                                t.Text4 = "Late"
                                SelectTaskCell Row:=t.ID, Column:="Text4", RowRelative:=False
                                ActiveCell.CellColor = pjRed
                            ElseIf t.Start1 > Now Then
                                t.Text4 = "Complete in " & DateDiff("d", Now, t.Start1) & " days"
                                If DateDiff("d", Now, t.Start1) <= Days Then 'Close
                                    SelectTaskCell Row:=t.ID, Column:="Text4", RowRelative:=False
                                    ActiveCell.CellColor = pjYellow
                                Else 'Not Due
                                    SelectTaskCell Row:=t.ID, Column:="Text4", RowRelative:=False
                                    ActiveCell.CellColor = pjGreen
                                End If
                            End If
                        Else
                            t.Text4 = "(" & DateDiff("d", t.Start2, t.Start1) & " days)"
                            If DateDiff("d", t.Start2, t.Start1) < 0 Then 'Late
                                SelectTaskCell Row:=t.ID, Column:="Text4", RowRelative:=False
                                ActiveCell.CellColor = pjRed
                            Else 'On Time
                                SelectTaskCell Row:=t.ID, Column:="Text4", RowRelative:=False
                                ActiveCell.CellColor = pjGreen
                            End If
                        End If
                    End If
        Next t  
    End Sub

    This macro runs "correctly", however, Error '1004' occurs after only 76 cells are colored (all in the same column - "Text4"). And for the life of me, I can't figure out why.

    My goal is for all 200 cells in the column to become colored without the error occurring.

    Thank you so much for your time and thanks for referencing the Filter Method code.  I was previously using Font32Ex to format one cell at a time, but utilizing it for multiple cells at once will definitely be handy in the future.

    Jake

    Tuesday, December 1, 2020 12:06 AM
  • Jake,

    Thanks for posting your complete code but I guarantee it does not run "correctly". I do not get the error you see but the code always fails the, If t.Start2 = "N/A" Then, statement. Start2 will either be a date or "NA" but it will never be "N/A".

    Other than that, the code runs for me on a test file with 181 task lines. I get no errors.

    If you are trying to test for blank task lines with the, If (t.Name = "") Then, statement, the best way to do that is with:

    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then

    If you ARE looking for tasks with the Name field blank then that sounds like a very strange file to me.

    Since it works for me, would you be willing to send me your Project file so I can do some testing? My address is below, I will ask some questions.

    John

    jmacprojataticlouddotdotcom

    (remove obvious redundancies)

    Tuesday, December 1, 2020 8:49 PM
  • John,

    You are correct.  "N/A" should read "NA"... oops.

    But regardless, I took your prior advice and completely switched over to the filter approach.

    THANK YOU!

    The code ended up taking the form of:

         FilterEdit Name:= ...  'Creates filter to select rows containing the needed cells

         FilterApply Name:= ... 'Applies the filter

         SelectColumn:= ...  'Selects column containing the needed cells within the filter

         Font32Ex CellColor:= 255 'Colors the column

         ViewApply Name:= ...  'Switches back to the original view

    Using FilterApply/SelectColumn allowed me to format multiple cells at once.  (I previously did not know this was possible).

    Again, thank you for your guidance on this issue.  I really appreciate your time!

    Jake    

    Wednesday, December 2, 2020 1:05 AM
  • Jake,

    You're welcome and thanks for the feedback.

    John

    Wednesday, December 2, 2020 1:19 AM