there is the functions codes in the example from previous post...
check macro security: macro should be enabled for these functions to work
Quote:
|
If you want to use a UDF in more than one workbook, you can save your functions in your own custom add-in. Simply save your excel file that contains your VBA functions as an add-in file (.xla). Then load the add-in (Tools > Add-Ins...). Warning! Be careful about using custom functions in spreadsheets that you need to share with others. If they don't have your add-in, the functions will not work when they use the spreadsheet.
|
anyway, the functions are:
Code:
Function CellColorIndex(InRange As Range, Optional _
OfText As Boolean = False) As Integer
Application.Volatile True
If OfText = True Then
CellColorIndex = InRange(1, 1).Font.ColorIndex
Else
CellColorIndex = InRange(1, 1).Interior.ColorIndex
End If
End Function
Function SumIfByColor(InRange As Range, _
WhatColorIndex As Integer, SumRange As Range, _
Optional OfText As Boolean = False) As Variant
Dim OK As Boolean
Dim Ndx As Long
Application.Volatile True
If (InRange.Rows.Count <> SumRange.Rows.Count) Or _
(InRange.Columns.Count <> SumRange.Columns.Count) Then
SumIfByColor = CVErr(xlErrRef)
Exit Function
End If
For Ndx = 1 To InRange.Cells.Count
If OfText = True Then
OK = (InRange.Cells(Ndx).Font.ColorIndex = WhatColorIndex)
Else
OK = (InRange.Cells(Ndx).Interior.ColorIndex = WhatColorIndex)
End If
If OK And IsNumeric(SumRange.Cells(Ndx).Value) Then
SumIfByColor = SumIfByColor + SumRange.Cells(Ndx).Value
End If
Next Ndx
End Function
Function SumByColor(InRange As Range, WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Double
'
' This function return the SUM of the values of cells in
' InRange with a background color, or if OfText is True a
' font color, equal to WhatColorIndex.
'
Dim Rng As Range
Dim OK As Boolean
Application.Volatile True
For Each Rng In InRange.Cells
If OfText = True Then
OK = (Rng.Font.ColorIndex = WhatColorIndex)
Else
OK = (Rng.Interior.ColorIndex = WhatColorIndex)
End If
If OK And IsNumeric(Rng.Value) Then
SumByColor = SumByColor + Rng.Value
End If
Next Rng
End Function
Another reason for a function not to work, is if there are features in this macro created in office 2007 no longer supported in office 2010, which i think it's not the case here...