Method 'Color' of object 'Font' failed - excel

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 3rd 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