Visual Basic Function works fine in Excell 2003 but not in Excel 2

R

Roger

I have an Excel worksheet with Buttons and Macros and Visual Basic code which
was created in Excel 2003 and works fine (everything functions). However,
when I moved the file to Excel 2007, only the Visual Basic Function no longer
works (the macros and buttons operate fine).

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.
 
H

Harlan Grove

Roger said:
. . . 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? . . .
Click to expand...

Too light on details. What do the formula and the udf look like?
 
R

Roger

Harlan, eight functions were given to me to allow me to COUNT the background
color (red in my example below) set by Conditional Format logic. The formula
to do so is:

=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
 
R

Roger

Harlan, another point. I'd be happy to send you the spreadsheet - just send
me a note. My id is: (e-mail address removed) - thanks.
 
J

JLatham

I've just started tinkering with this, but one thing I found is in
Function CFArrayColours(.....)
at the very end, you've got the name of the function spelled wrong:
CFArrayColors = aryColours
should be
CFArrayColours = aryColours

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.
 
R

Roger

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. Thank you very much.
Roger
 
R

Roger

Yes, I did see that reply - it had no impact on the results. Having made
that change did not impact the end results at all. I'm still at a loss to be
able to get it to work. My brother took a look at the code and thinks it
might relate to the "codes" assigned to the colors I am setting in the
conditional formats (e.g., 3 being red in Excel 2003 and possibly being some
other code in Excel 2007). I doubt this is the problem. Any ideas would be
appreciated. Thanks.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Menu Macro Not Executing - Need Help 1
Imported Visual Basic Module - Save Macros for use in Excel 1
visual basic code in 2003 vs 2007 1
visual basic compile error in excel 2003 2
Enabling Visual Basic in Excel 2007 1
VBA Macro Training in Chennai 0
excel Visual basic opens then closes for users 0
<<<<excel and VB lookup 2

Top