M
maryj
Bob,
You helped me awhile back write some code to count conditional formatting.
That worked great!!! For awhile....
Now the client has changed it so that the data with the conditonal
formatting is in a pivot table. Everytime the pivot table updates, the result
of the CFColorCount function changes to #Value. If we manually change the
range to the exact range, the function will work. I created a dynamic range
to select the pivot data, but the function won't accept named ranges for the
argument. Is there any way the function will allow dynamic ranges??? We
really appreciate all of your help. Below is the code you provided us earlier.
Public Function CFColorCount(rng As Range, _
ciValue, _
Optional text As Boolean = False)
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim aryColours As Variant
If rng.Areas.Count > 1 Then
CFColorCount = "#Too many areas!"
Exit Function
End If
If rng.Cells.Count = 1 Then
CFColorCount = -CLng(CFColorindex(rng, text) = ciValue)
Else
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each cell In row.Cells
j = j + 1
CFColorCount = CFColorCount - _
(CLng(CFColorindex(cell, text)) = ciValue)
Next cell
Next row
End If
End Function
Public Function CFColorindex(rng As Range, _
Optional text As Boolean = False)
'---------------------------------------------------------------------
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 text Then
If Not IsNull(oFC.Font.ColorIndex) Then
CFColorindex = oFC.Font.ColorIndex
End If
Else
If Not IsNull(oFC.Interior.ColorIndex) Then
CFColorindex = oFC.Interior.ColorIndex
End If
End If
Exit Function
End If
Next oFC
End If 'rng.FormatConditions.Count > 0
End Function
You helped me awhile back write some code to count conditional formatting.
That worked great!!! For awhile....
Now the client has changed it so that the data with the conditonal
formatting is in a pivot table. Everytime the pivot table updates, the result
of the CFColorCount function changes to #Value. If we manually change the
range to the exact range, the function will work. I created a dynamic range
to select the pivot data, but the function won't accept named ranges for the
argument. Is there any way the function will allow dynamic ranges??? We
really appreciate all of your help. Below is the code you provided us earlier.
Public Function CFColorCount(rng As Range, _
ciValue, _
Optional text As Boolean = False)
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim aryColours As Variant
If rng.Areas.Count > 1 Then
CFColorCount = "#Too many areas!"
Exit Function
End If
If rng.Cells.Count = 1 Then
CFColorCount = -CLng(CFColorindex(rng, text) = ciValue)
Else
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each cell In row.Cells
j = j + 1
CFColorCount = CFColorCount - _
(CLng(CFColorindex(cell, text)) = ciValue)
Next cell
Next row
End If
End Function
Public Function CFColorindex(rng As Range, _
Optional text As Boolean = False)
'---------------------------------------------------------------------
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 text Then
If Not IsNull(oFC.Font.ColorIndex) Then
CFColorindex = oFC.Font.ColorIndex
End If
Else
If Not IsNull(oFC.Interior.ColorIndex) Then
CFColorindex = oFC.Interior.ColorIndex
End If
End If
Exit Function
End If
Next oFC
End If 'rng.FormatConditions.Count > 0
End Function