When I use "Evaluate Formula" for the Visual Basic Function, it provides the
correct answer. However, when I press Calculate (F9) or when I press Enter
with the cursor at the end of the function's formula on the "Fx" line, I get
"#VALUE!" and don't understand why. Any ideas? Thanks.
Too light on details. What do the formula and the udf look like?
=CFColorCount(B11:B825,3)
Count color "3" (red) in cels B11 to B825).
Function given to me which works perfectly in Excel 2003:
Function IsCF(rng As Range) As Boolean 'Figure 1
Set rng = rng(1, 1)
IsCF = rng.FormatConditions.Count > 0
End Function
Function IsCFMet1(rng As Range) As Boolean 'Figure 2
Dim oFC As FormatCondition
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
IsCFMet1 = rng.Value = oFC.Formula1
Case xlNotEqual
IsCFMet1 = rng.Value <> oFC.Formula1
Case xlGreater
IsCFMet1 = rng.Value > oFC.Formula1
Case xlGreaterEqual
IsCFMet1 = rng.Value >= oFC.Formula1
Case xlLess
IsCFMet1 = rng.Value < oFC.Formula1
Case xlLessEqual
IsCFMet1 = rng.Value <= oFC.Formula1
Case xlBetween
IsCFMet1 = (rng.Value >= oFC.Formula1 And rng.Value <=
oFC.Formula2)
Case xlNotBetween
IsCFMet1 = (rng.Value < oFC.Formula1 Or rng.Value >
oFC.Formula2)
End Select
End If
If IsCFMet1 Then Exit Function
Next oFC
End If
End Function
Function IsCFMet2(rng As Range) As Boolean 'Figure 3
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 = xlExpression Then
'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
IsCFMet2 = rng.Parent.Evaluate(sF1)
End If
If IsCFMet2 Then Exit Function
Next oFC
End If
End Function
Function IsCFMet(rng As Range) As Boolean 'Figure 4
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
IsCFMet = rng.Value = oFC.Formula1
Case xlNotEqual
IsCFMet = rng.Value <> oFC.Formula1
Case xlGreater
IsCFMet = rng.Value > oFC.Formula1
Case xlGreaterEqual
IsCFMet = rng.Value >= oFC.Formula1
Case xlLess
IsCFMet = rng.Value < oFC.Formula1
Case xlLessEqual
IsCFMet = rng.Value <= oFC.Formula1
Case xlBetween
IsCFMet = (rng.Value >= oFC.Formula1 And rng.Value <=
oFC.Formula2)
Case xlNotBetween
IsCFMet = (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
IsCFMet = rng.Parent.Evaluate(sF1)
End If
If IsCFMet Then Exit Function
Next oFC
End If 'rng.FormatConditions.Count > 0
End Function
Function CFColorindex0(rng As Range) 'Figure 5
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
CFColorindex0 = rng.Value = oFC.Formula1
Case xlNotEqual
CFColorindex0 = rng.Value <> oFC.Formula1
Case xlGreater
CFColorindex0 = rng.Value > oFC.Formula1
Case xlGreaterEqual
CFColorindex0 = rng.Value >= oFC.Formula1
Case xlLess
CFColorindex0 = rng.Value < oFC.Formula1
Case xlLessEqual
CFColorindex0 = rng.Value <= oFC.Formula1
Case xlBetween
CFColorindex0 = (rng.Value >= oFC.Formula1 And rng.Value
<= oFC.Formula2)
Case xlNotBetween
CFColorindex0 = (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
CFColorindex0 = rng.Parent.Evaluate(sF1)
End If
If CFColorindex0 Then
If Not IsNull(oFC.Interior.ColorIndex) Then
CFColorindex0 = oFC.Interior.ColorIndex
Exit Function
End If
End If
Next oFC
End If 'rng.FormatConditions.Count > 0
End Function
Function CFColorindex(rng As Range, Optional text As Boolean = False)
'Figure 6
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
Function CFArrayColours(rng As Range, Optional text As Boolean = False)
'Figure 7
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim aryColours As Variant
If rng.Areas.Count > 1 Then
CFArrayColours = "#Too many areas!"
Exit Function
End If
If rng.Cells.Count = 1 Then
aryColours = CFColorindex(rng, text)
Else
aryColours = rng.Value
i = 0
For Each row In rng.Rows
i = i + 1
j = 0
For Each cell In row.Cells
j = j + 1
aryColours(i, j) = CFColorindex(cell, text)
Next cell
Next row
End If
CFArrayColors = aryColours
End Function
Function CFColorCount(rng As Range, ciValue, Optional text As Boolean =
False) 'Figure 8
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
"Harlan Grove" wrote:
> Roger <R...@discussions.microsoft.com> wrote...
> ....
"Harlan Grove" wrote:
> Roger <R...@discussions.microsoft.com> wrote...
> ....
if you aren't using Option Explicit in the module, this would go undetected
and the result would be that the Function never returns anything except the
odd "#Too many areas!" error message every now and then.
"Harlan Grove" wrote:
> Roger <R...@discussions.microsoft.com> wrote...
> ....
Did you see JLatham's reply?
http://groups.google.com/group/microsoft.public.excel.misc/msg/26283ad3ba602a0e
"Harlan Grove" wrote:
> Roger <Ro...@discussions.microsoft.com> wrote...
> >I assume by everyone's silence on this matter that there is no
> >easy solution to get my Excel 2003 worksheet working in Excel
> >2007. If anyone feels otherwise, please reply.
> ....