Colorindex

[Mike H]

Rick, Jacob,

Apologies for breaking in on your thread but I think Bob Philips has already
done this


Bob's function or view his page

http://www.xldynamic.com/source/xld.CFConditions.html

'---------------------------------------------------------------------
Public Function CFColorindex(rng As Range)
'---------------------------------------------------------------------
Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

Set rng = rng(1, 1)
If rng.FormatConditions.Count > 0 Then
For Each oFC In rng.FormatConditions
If oFC.Type = xlCellValue Then
Select Case oFC.Operator
Case xlEqual
CFColorindex = rng.Value = oFC.Formula1
Case xlNotEqual
CFColorindex = rng.Value <> oFC.Formula1
Case xlGreater
CFColorindex = rng.Value > oFC.Formula1
Case xlGreaterEqual
CFColorindex = rng.Value >= oFC.Formula1
Case xlLess
CFColorindex = rng.Value < oFC.Formula1
Case xlLessEqual
CFColorindex = rng.Value <= oFC.Formula1
Case xlBetween
CFColorindex = (rng.Value >= oFC.Formula1 And _
rng.Value <= oFC.Formula2)
Case xlNotBetween
CFColorindex = (rng.Value < oFC.Formula1 Or _
rng.Value > oFC.Formula2)
End Select
Else
're-adjust the formula back to the formula that applies
'to the cell as relative formulae adjust to the activecell
With Application
iRow = rng.Row
iColumn = rng.Column
sF1 = .Substitute(oFC.Formula1, "ROW()", iRow)
sF1 = .Substitute(sF1, "COLUMN()", iColumn)
sF1 = .ConvertFormula(sF1, xlA1, xlR1C1)
sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
End With
CFColorindex = rng.Parent.Evaluate(sF1)
End If

If CFColorindex Then
If Not IsNull(oFC.Interior.ColorIndex) Then
CFColorindex = oFC.Interior.ColorIndex
Exit Function
End If
End If
Next oFC
End If 'rng.FormatConditions.Count > 0

End Function

Mike

 

[Rick Rothstein]

Hey! We were having fun here and you (and Bob) ruined it for us.<g>

I misread something earlier in the thread which seemed to indicate that
Bob's function wasn't complete, but in testing it, I see that it is. Thanks
for the wake-up call.

 

[Al_82]

Rick,

Thanks for demonstrating that with VBA we should never say something can't
be done. While reading through your function, it occurred to me that I have
much easier ways to search my worksheet for the condition of interest then to
look for the format it sets. After all, the conditional format is intended
to get the users attention, not that of VBA.

Thank you for the lesson.

 

[Jacob Skaria]

Mike; Thanks for that post. We are re-inventing the wheel...

Rick..thanks for testing that....it is getting better & refined

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)

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) And C.Value _
<= GetCFV(FC.Formula2) Then blnMatch = True: Exit For
Case xlNotBetween '2
If C.Value < GetCFV(FC.Formula1) Or C.Value _

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

Case xlEqual '3
If C.Value = GetCFV(FC.Formula1) Then blnMatch = True: Exit For
Case xlNotEqual '4
If C.Value <> GetCFV(FC.Formula1) Then blnMatch = True: Exit For
Case xlGreater '5
If C.Value > GetCFV(FC.Formula1) Then blnMatch = True: Exit For
Case xlGreaterEqual '6
If C.Value >= GetCFV(FC.Formula1) Then blnMatch = True: Exit For
Case xlLess '7
If C.Value < GetCFV(FC.Formula1) Then blnMatch = True: Exit For
Case xlLessEqual '8
If C.Value <= GetCFV(FC.Formula1) 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)
'Get text string or numeric from CF formula
If Not IsNumeric(strData) Then
GetCFV = Mid(strData, 3, Len(strData) - 3)
Else
GetCFV = CDbl(strData)
End If
End Functio
'-------------------------------------------------------------------------------



If this post helps click Yes

 

[Jacob Skaria]

Mike and Bob,

Rick is right Bobs code do not handle text strings..

If this post helps click Yes