*** CODE UPDATE ***
When I first developed the DisplayedColor function, it only returned a ColorIndex value. Since the ColorIndex will not return 0 as a value, I chose to let that be the returned value if an improper first argument was specified. I figured that would be better than raising an actual error which would have to be dealt with using an On Error statement of some kind. However, I was not able to let well-enough alone and added additional functionality to the DisplayedColor function, one of which being the ability to return the RGB Long Color value as well as the ColorIndex. Well, it just occurred to me that 0 is a proper Long value for an RGB Color (it is the color value for black), so I decided raising an error was the only way to go in order to avoid any confusion that returning 0 would produce when the ReturnColorIndex argument is set to False. Only one line of code needed to be changed to accomplish this; however, while I was "tinkering around", I decided to rearrange the Case statements inside the Select Case block into a more logical order (I know, this was not necessary to do, but hey, what can I say, it was bothering me
). Here is the revised code...
Code:
' Arguments
' ----------------
' Cell - Required Range, not a String value, for a **single** cell
'
' CellInterior - Optional Boolean (Default = True)
' True makes function return cell's Interior Color or ColorIndex based on
' the ReturnColorIndex argument False makes function return Font's Color or
' ColorIndex based on the ReturnColorIndex argument
'
' ReturnColorIndex - Optional Boolean (Default = True)
' True makes function return the ColorIndex for the cell property determined
' by the CellInterior argument False make function return the Color for the
' cell property determined by the CellInterior argument
'
Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, _
Optional ReturnColorIndex As Long = True) As Long
Dim X As Long, Test As Boolean, CurrentCell As String
If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."
CurrentCell = ActiveCell.Address
For X = 1 To Cell.FormatConditions.Count
With Cell.FormatConditions(X)
If .Type = xlCellValue Then
Select Case .Operator
Case xlBetween: Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
Case xlNotBetween: Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
Case xlEqual: Test = Evaluate(.Formula1) = Cell.Value
Case xlNotEqual: Test = Evaluate(.Formula1) <> Cell.Value
Case xlGreater: Test = Cell.Value > Evaluate(.Formula1)
Case xlLess: Test = Cell.Value < Evaluate(.Formula1)
Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
Case xlLessEqual: Test = Cell.Value <= Evaluate(.Formula1)
End Select
ElseIf .Type = xlExpression Then
Application.ScreenUpdating = False
Cell.Select
Test = Evaluate(.Formula1)
Range(CurrentCell).Select
Application.ScreenUpdating = True
End If
If Test Then
If CellInterior Then
DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
Else
DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
End If
Exit Function
End If
End With
Next
If CellInterior Then
DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
Else
DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
End If
End Function
NOTE: I haven't checked this out yet, but someone contacted me and said this function only works if the cell's conditional formatting only consists of color rendering conditions... apparently intervening conditions doing other things besides coloring a cell or its text will screw-up the function's calculations. I'll eventually check this out, but until then... be advised.
) is the result of that effort...
Reply With Quote
Originally Posted by rishidoshi
Bookmarks