Method 'Color' of object 'Font' failed

Question

I'm getting the title error message in my Excel 2010 VBA code. I've looked at this question and this question which both look similar, but nether seems to address the issue.

My code parses through all the conditional formatting on the current worksheet and dumps it as text to another (newly created) worksheet - the ultimate goal is to load those same conditions to a nearly identical worksheet (thus I can't just copy the base worksheet).

The code is:

Public Sub DumpExistingRules()
'portions of the code from here: http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/

Const RuleSheetNameSuffix As String = "-Rules"

  Dim TheWB As Workbook
  Set TheWB = ActiveWorkbook

  Dim SourceSheet As Worksheet
  Set SourceSheet = TheWB.ActiveSheet

  Dim RuleSheetName As String
  RuleSheetName = SourceSheet.Name & RuleSheetNameSuffix
  On Error Resume Next                          'if the rule sheet doesn't exist it will error, we don't care, just move on
  Application.DisplayAlerts = False
  TheWB.Worksheets(RuleSheetName).Delete
  Application.DisplayAlerts = True
  On Error GoTo EH

  Dim RuleSheet As Worksheet
  Set RuleSheet = TheWB.Worksheets.Add
  SourceSheet.Activate
  RuleSheet.Name = RuleSheetName

  RuleSheet.Range(RuleSheet.Cells(1, CellAddrCol), RuleSheet.Cells(1, OperatorCodeCol)).Value = Array("Cell Address", "Rule Type", "Type Code", "Applies To", "Stop", "Font.ColorRGB", "Formula1", "Formula2", _
            "Interior.ColorIndexRGB", "Operator Type", "Operator Code")

  Dim RuleRow As Long
  RuleRow = 2
  Dim RuleCount As Long
  Dim RptCol As Long
  Dim SrcCol As Long
  Dim RetryCount As Long
  Dim FCCell As Range
  For SrcCol = 1 To 30
    Set FCCell = SourceSheet.Cells(4, SrcCol)
    For RuleCount = 1 To FCCell.FormatConditions.Count
      RptCol = 1
      Application.StatusBar = "Cell: " & FCCell.Address
      PrintValue RuleSheet, RuleRow, CellAddrCol, FCCell.Address
      PrintValue RuleSheet, RuleRow, RuleTypeCol, FCTypeFromIndex(FCCell.FormatConditions.Item(RuleCount).Type)
      PrintValue RuleSheet, RuleRow, RuleCodeCol, FCCell.FormatConditions.Item(RuleCount).Type
      PrintValue RuleSheet, RuleRow, AppliesToCol, FCCell.FormatConditions.Item(RuleCount).AppliesTo.Address
      PrintValue RuleSheet, RuleRow, StopCol, FCCell.FormatConditions.Item(RuleCount).StopIfTrue
      If FCCell.FormatConditions.Item(RuleCount).Type <> 8 Then
        PrintValue RuleSheet, RuleRow, Formula1Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula1, Len(FCCell.FormatConditions.Item(RuleCount).Formula1) - 1)    'remove the leading "=" sign
        If FCCell.FormatConditions.Item(RuleCount).Type <> 2 And _
           FCCell.FormatConditions.Item(RuleCount).Type <> 1 Then
          PrintValue RuleSheet, RuleRow, Formula2Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula2, Len(FCCell.FormatConditions.Item(RuleCount).Formula2) - 1)  'remove the leading "=" sign
        End If
      End If
      RetryCount = 0
RetryColor:
      PrintValue RuleSheet, RuleRow, FontColorCol, "'" & GetRGB(FCCell.FormatConditions(RuleCount).Font.Color)
      PrintValue RuleSheet, RuleRow, IntColorIdxCol, "'" & GetRGB(FCCell.FormatConditions.Item(RuleCount).Interior.Color)
      If FCCell.FormatConditions.Item(RuleCount).Type = 1 Then
        PrintValue RuleSheet, RuleRow, OperatorTypeCol, OperatorType(FCCell.FormatConditions.Item(RuleCount).Operator)
        PrintValue RuleSheet, RuleRow, OperatorCodeCol, FCCell.FormatConditions.Item(RuleCount).Operator
      End If
      RuleRow = RuleRow + 1
    Next
  Next

  RuleSheet.Rows(1).AutoFilter = True

CleanExit:
  If RuleRow = 2 Then
    PrintValue RuleSheet, RuleRow, RptCol, "No Conditional Formatted cells were found on " & SourceSheet.Name
  End If
  On Error Resume Next
  Set SourceSheet = Nothing
  Set TheWB = Nothing
  Application.StatusBar = ""
  On Error GoTo 0

  MsgBox "Done"

  Exit Sub

EH:
  If Err.Number = -2147417848 Then
    MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color
    If RetryCount < 5 Then
      RetryCount = RetryCount + 1
      Resume RetryColor
    Else
      MsgBox "RetryCount =  " & RetryCount
      Resume Next
    End If
  Else
    MsgBox "Error Number: " & Err.Number & vbCrLf & _
           " Description: " & Err.Description & vbCrLf & _
           "Cell Address: " & FCCell.Address & vbCrLf
    Resume Next
  End If

End Sub

The line in question is the one immediately following the RetryColor: label. When that line of code is executed for a Unique Values conditional formatting rule (i.e. highlight duplicates), I get err.number = -2147417848' and err.description = "Method 'Color' of object 'Font' failed". The code drops to EH:, falls into the first IF statement, and displays the MsgBox without any problem.

Why is it that the statement FCCell.FormatConditions(RuleCount).Font.Color fails the first time, but executes perfectly the second time in the error handler? Once I've clicked the OK button on the MsgBox, execution resumes at the RetryColor: label, the statement executes correctly, and all is good.

---

---

To make sure this is clear, if I comment out the

MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color

line in EH:, the code will error 5 times without ever outputting the RGB code to my output worksheet, then continue on its way. If that line is in EH: (as shown above), I get the MsgBox and the .Font.Color will now be read in the main code and execution will continue as expected without error.

---

---

UPDATE: It seems that after letting this code sit for a week while I worked on something else, that it's now slightly more broken. In the error handler, I now get the titular error message popping, up. If I hit F5, it will execute and display the MsgBox with the color code.

So now, it will fail twice, then execute properly the 3^rd time.

---

For completeness, here's the code for GetRGB:

Private Function GetRGB(ByVal ColorCode As Variant) As String

  Dim R As Long
  Dim G As Long
  Dim B As Long

  If IsNull(ColorCode) Then
    GetRGB = "0,0,0"
  Else
    R = ColorCode Mod 256
    G = ColorCode \ 256 Mod 256
    B = ColorCode \ 65536 Mod 256

    GetRGB = R & "," & G & "," & B
  End If

End Function

I have to pass the parameter as a Variant because when the .Font.Color is set to Automatic in the color chooser, I get a NULL returned, thus the If statement in GetRGB.

Another Update: After letting this code sit for a few more weeks (it's to make my life easier, not an official project, therefore it's at the bottom of the priority list), it seems that it will generate the error on every call now, instead of just sometimes. However, the code will execute properly in the immediate window!

The yellow highlighted line is the one that generated the error, yet you can see the results in the immediate window.

---

Also (I realize this should really be another question), if anybody happens to quickly see any reason for the SourceSheet.Activate line, please let me know - I was getting random errors without it, so I put that in. Usually these errors are because of unqualified references working on the currently active sheet (which would be RuleSheet as soon as it's created), but I thought I had all my references qualified. If you see something I missed, please pipe up! Otherwise, I'll probably head over to CodeReview to have them take a look at what I missed once I get this working properly.

Answer 1

I think I've reduced this to a root cause.

I manually added 2 different types of FormatConditions in cell Sheet1.A1:

And here's my code, in the same workbook.

Sub foo()

  Dim rng As Range
  Set rng = Sheet1.Range("A1")

  Dim fc As Object
  On Error Resume Next

  Sheet2.Activate
  Set fc = rng.FormatConditions(1)
  Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type
  Debug.Print , fc.Font.Color
  Set fc = rng.FormatConditions(2)
  Dim fnt As Font2
  Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type
  Debug.Print , fc.Font.Color

  Sheet1.Activate
  Set fc = rng.FormatConditions(1)
  Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type
  Debug.Print , fc.Font.Color
  Set fc = rng.FormatConditions(2)
  Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type
  Debug.Print , fc.Font.Color

End Sub

And here's the output:

Sheet2   FormatCondition   1 
         3243501 
Sheet2   Top10             5 
Sheet1   FormatCondition   1 
         3243501 
Sheet1   Top10             5 
         13998939 

So the FormatConditions.Item method will not always return a FormatCondition

I can't reproduce your Immediate Window behavior, so maybe you inadvertently activated the sheet?

If I remove the On Error Resume, and break at the error for the Top10.Font.Color call, and then query in the debug window, I get:

Run-time error '-2147417848 (80010108)':

Automation error The object invoked has disconnected from its clients.

For which Google takes me to Error or Unexpected Behavior with Office Automation When You Use Early Binding in Visual Basic

Based on my results, when the FormatConditions.Item returns a Top10 (and maybe other types, including your UniqueValues type), it isn't possible to access the Font.Color property unless the range's sheet is active.

But it looks like you have it active? I wonder if you're changing the active sheet in PrintValue?

Answer 2

Regarding your second question:
I have always have had problems with setting cells that are not in an active sheet, the most probable cause for the problem in doing SourceSheet.Activate relies on the fact of the Set range later:

Set FCCell = SourceSheet.Cells(4, SrcCol)

I've found that, if the sheet is not active, it would fail within the cells() argument, I think the best approach for this is using Range before Cells.
This may be the case. So for this example I would do something like:

With SourceSheet:Set FCCell = .Range(.Cells(4,SrcCol):End With