UDF help

[Sylvan]

Kind of tricky to explain. I've written a UDF to sum bolded values until the next cell with a fill color is encountered. It works fine until it's copied down as part of a range and then I get a #VALUE! error. I'll then enter some values and it starts working. But then when I run a macro to paste a range below the UDF it gives me the #VALUE! error again.

Here's the code -- any ideas? Thanks in advance

Function ROOMSUM(MyRange As Range) As Double
'Sums bolded values down until the next colored cell

Dim rCell As Range

For Each rCell In MyRange
If rCell.Interior.ColorIndex <> xlNone Then Exit Function
If rCell.Font.Bold = True Then
ROOMSUM = ROOMSUM + rCell.Value
End If
Next rCell

End Function

 

[Sylvan]

Thanks shg. Actually the currency was only in there for a second, just happened to be the second when I copied and pasted.

The debug in every case is giving me a cell 2 down from the UDF which contains the formula =L21*M21 the result of which is $0.00 until data is entered and then everything is fine. So how do I get it to recognize the 0 as a number?

 

[shg]

I assume there are no merged cells.

When the code stops, in the Immediate window, enter

? VarType(rCell)

What's that show?

 

[Sylvan]

No, no merged cells.

When I enter ? VarType(rCell) it gives me a 6. If I enter ? VarType(ThisCell) I get a 0.

 

[Sylvan]

Oops, my mistake -- vartype 0 for both of them.

 

[shg]

That means the cell is Empty, which probably means it hasn't recalculated yet. See http://www.decisionmodels.com/calcsecretsj.htm#value

So just to see what happen, try this:

Function ROOMSUM(MyRange As Range) As Double
    Dim rCell     As Range
 
    On Error GoTo Oops
    For Each rCell In MyRange
        With rCell
            If .Interior.ColorIndex <> xlColorIndexNone Then Exit Function
            If .Font.Bold = True Then
                If VarType(rCell.Value2) = vbDouble Then
                    ROOMSUM = ROOMSUM + rCell.Value2
                ElseIf Not IsEmpty(cell.Value2) Then
                    GoTo Oops
                End If
            End If
        End With
    Next rCell
    Exit Function
 
Oops:
    Debug.Print Application.ThisCell.Address, rCell.Address
    Stop
End Function

 

[Sylvan]

Nope. Still both vartype 0

 

[shg]

Post a minimal workbook that illustrates the problem on box.net or similar.

Did you fix the typo in the ElseIf line to rCell?

 

[Sylvan]

Yeah I caught the type.

Here's the link to boxnet

http://www.box.net/shared/zj2ata2q6s

 

[shg]

It's the Interior property that's causing the error. My only suggestion is to punt on RoomSum and use this formula in N12:

=SUMPRODUCT(N13:INDEX(N:N, ROW() + IF(COUNTIF(A13:A977, "New Room"), MATCH("New Room", A13:A977, 0), 1000) - 1))

 

[Sylvan]

Hmm, ok thanks for all your help. That formula doesn't really work because I only want to add the cells in column N that are bolded -- as you have it, it sums everything until the next row with "New Room".