Colors of Cells With Conditional Formatting

[Faraz A. Qureshi]

I have a code for selecting the cells with specific interior color be
selected as follows, however, how to add cells colored similarly but due to
conditional formatting, whether by the 1st, 2nd or any condition?

Sub SlctClrCel(CONTROL As IRibbonControl)
Dim CRange As Range
Dim A As Range
Dim B As Range
RETRY:
Set A = Application.InputBox("Select A Sample Cell With The Desired Interior
Color.", Type:=8)
Set B = Application.InputBox("Looking In Which Range?" & vbNewLine &
"Remember To Select Only The Necessary Cells", Type:=8)
For Each C In B
If C.Interior.ColorIndex = A.Interior.ColorIndex Then
If CRange Is Nothing Then
Set CRange = C
Else
Set CRange = Union(CRange, C)
End If
End If
Next
If Not CRange Is Nothing Then
CRange.Select
Else
MsgBox ("None Found!")
End If
End Sub

 

[Jacob Skaria]

Hi Faraz

Try the below function to get the color index of a conditional formatted cell.

Function GetCFColorIndex(c As Range) As Variant
Dim intCount As Integer, FC As FormatCondition, blnMatch As Boolean
If c.Count <> 1 Then Exit Function
For intCount = 1 To c.FormatConditions.Count
'Loop through each Contidional Formatting
Set FC = c.FormatConditions(intCount)
Application.Volatile
If FC.Type = 1 Then
'Handle Type1-xlExpression (If 'Cell Value Is')
Select Case FC.Operator
Case xlBetween '1
If c.Value >= GetCFV(FC.Formula1, c) And c.Value _
<= GetCFV(FC.Formula2, c) Then blnMatch = True: Exit For
Case xlNotBetween '2
If c.Value < GetCFV(FC.Formula1, c) Or c.Value _

GetCFV(FC.Formula2, c) Then blnMatch = True: Exit For

Case xlEqual '3
If c.Value = GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
Case xlNotEqual '4
If c.Value <> GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
Case xlGreater '5
If c.Value > GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
Case xlGreaterEqual '6
If c.Value >= GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
Case xlLess '7
If c.Value < GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
Case xlLessEqual '8
If c.Value <= GetCFV(FC.Formula1, c) Then blnMatch = True: Exit For
End Select
Else
'Handle Type2-xlExternal (If 'Formula Is')
If Evaluate(Application.ConvertFormula( _
Application.ConvertFormula(FC.Formula1, xlA1, xlR1C1), _
xlR1C1, xlA1, , c)) Then blnMatch = True: Exit For
End If
Next

If blnMatch Then GetCFColorIndex = FC.Interior.ColorIndex
End Functio
'-------------------------------------------------------------------------------
Function GetCFV(strData As Variant, c As Range)
'Get text string or numeric from CF formula
If IsNumeric(strData) Then
GetCFV = CDbl(strData)
ElseIf InStr(strData, Chr(34)) Then
GetCFV = Mid(strData, 3, Len(strData) - 3)
Else
GetCFV = Range(Mid(Application.ConvertFormula( _
Application.ConvertFormula(strData, xlA1, xlR1C1), _
xlR1C1, xlA1, , c), 2))
End If
End Functio
'-------------------------------------------------------------------------------

 

[Faraz A. Qureshi]

Nice 2 hear from u after such a longtime pal!
Sure had been busy myself!
By the way Your recommended Function no doubt presents a good way but the
result changes to "1" everytime I carryout a step after inserting the UDF
GetCFColorIndex, any reason?

By the way, instead of a function any idea for a procedure?

 

[Jacob Skaria]

Paste both functions in a module and try with the macro.

The below will return the colorindex of cell D5. Try conditional formatting
cell D5 with fill color red and run the macro both with the condition and
without....If the cell is colored due to CF the macro will return the
colorindex applied...

Sub Macro1()
MsgBox GetCFColorIndex(Range("D5"))
End Sub

 

[Faraz A. Qureshi]

Dear Jacob,

Problem still exists. Can't describe the same in words. Emailing you a
sample file on your yahoo's jacs address. Please c if u can help me!
Sure am thankful 4 all your help pal!

 

[Jacob Skaria]

Faraz; I should have mentioned the code works fine only in XL2003.
Conditional formatting has changed a lot in XL2007 and I havent tested this
for XL2007.