Count coloured cells - But treat cells with colour and value as 0.5

[Wabby]

Hi guys,

I have a spreadsheet and a module that allows me to count coloured cells.

If the cell with a colour in has ANY text in it, then I need it to count it as 0.5 instead of 1.

Any ideas?

Current Code:

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

    Dim rCell As Range

    Dim lCol As Long

    Dim vResult



''''''''''''''''''''''''''''''''''''''

'Written by Ozgrid Business Applications

'www.ozgrid.com



'Sums or counts cells based on a specified fill color.

'''''''''''''''''''''''''''''''''''''''

  

    lCol = rColor.Interior.ColorIndex



    If SUM = True Then

        For Each rCell In rRange

            If rCell.Interior.ColorIndex = lCol Then

                vResult = WorksheetFunction.SUM(rCell, vResult)

            End If

        Next rCell

    Else

        For Each rCell In rRange

            If rCell.Interior.ColorIndex = lCol Then

                vResult = 1 + vResult

            End If

        Next rCell

    End If



   ColorFunction = vResult

End Function

Cheers

[DonkeyOte]

Using your existing function change

vResult = WorksheetFunction.SUM(rCell, vResult)

to

vResult = WorksheetFunction.SUM(IIf(IsNumeric(rCell), rCell, 0.5), vResult)

If you range contains formulae nulls and you wish for them to be excluded then

vResult = WorksheetFunction.SUM(IIf(IsNumeric(rCell), rCell, (rCell <> "") * -0.5), vResult)

[Wabby]

If it has a value (text value) can I make it count is as 0.5 instead of 1?

Thanks for the help so far

[DonkeyOte]

Let's just clarify what you want to do exactly.

For counting cells of a given colour, non-blanks are worth 0.5 and blanks 0 ?

For summing cells of a given colour, non-numerics worth 0

[DonkeyOte]

I'm heading off line, assuming prior post is correct then below is the original condensed and altered.

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
    Dim rCell As Range
    Dim lCol As Long
    Dim vResult
    lCol = rColor.Interior.ColorIndex
    For Each rCell In rRange
        If rCell.Interior.ColorIndex = lCol Then
            If SUM Then
                vResult = WorksheetFunction.SUM(rCell.Value, vResult)
            Else
                vResult = vResult + IIf(rCell.Value <> "", 0.5, 0)
            End If
        End If
    Next rCell
    ColorFunction = vResult
End Function

Though FWIW IMO it is ill advised to differentiate / calculate based on "feel / appearance".

[Wabby]

Let's just clarify what you want to do exactly.

For counting cells of a given colour, non-blanks are worth 0.5 and blanks 0 ?

For summing cells of a given colour, non-numerics worth 0

Non blanks are worth 0.5 and blanks are worth 1.

I am trying to count a spreadsheet that has been in use for several years - usings colours to display holiday days - And text within that colour to stipulate half a holiday day.

Many thanks for your help so far

[DonkeyOte]

Non blanks are worth 0.5 and blanks are worth 1

Change the 0 in the IIF to 1.

usings colours to display holiday days - And text within that colour to stipulate half a holiday day

Would be better to use H (or 1) in cell to denote Holiday and HH (or 0.5) for Half Holiday - use Conditional Formatting to apply colour based on the cell value if required. No VBA required from that point forth.