VBA SUM OF COLORED CELLS?? PLEASE HELP

[JustGary]

Good evening. I am new to VBA and need help with a quick function. I have a spread sheet that has multiple products and prices. I need a code or function that will allow me to get the sum of cells based on the color they are highlighted. Ie: The user will click multiple cells and highlight them all yellow..the formula/function would total all those quantities in the yellow cells and display the total in a cell at the bottom of the sheet labelled "Total". I really appreciate the help. Im not sure how complicated it is but if you can help me, please do so as if you were talking to someone with no VBA skills...which you are. Thanks

[Paul_Hossler]

Greetings and welcome

I'd do a User Defined Function (UDF)

A UDF was the very first thing I ever wrote in VBA so I think that they're the easiest to start with

I had thought about a color-based filter, by I think there's too many variables doing it that way.

Maybe someone else here will have some more / better ideas

I used the .ColorIndex property (that's one that you pick from the Fill pallette with the 56 little color boxes) so if you're creative with custom colors it might not work


Option Explicit

Function SumByColor(RangeToSum As Range, CellWithTheColorToMatch As Range) As Variant
Dim dSum As Double
Dim rData As Range, rCell As Range

SumByColor = CVErr(xlErrNA)

Set rData = Nothing
On Error Resume Next
Set rData = Intersect(RangeToSum, RangeToSum.Parent.UsedRange).SpecialCells(xlCellTypeConstants + xlCellTypeFormulas, xlNumbers)
On Error GoTo 0

If rData Is Nothing Then Exit Function

dSum = 0#
For Each rCell In rData.Cells
If rCell.Interior.ColorIndex = CellWithTheColorToMatch.Cells(1, 1).Interior.ColorIndex Then
dSum = dSum + rCell.Value
End If
Next
SumByColor = dSum
End Function


Here's a sample workbook

Free free to ask questions

Paul

[Teeroy]

Hi Paul, very neat. I've used Chip Pearson's RangeOfColor function for similar before but not as a UDF. If you have custom colors they "round" to the closest .Colorindex value which would generally be ok but if you happen to need finer color control couldn't you replace .Colorindex with .Color?

[Kenneth Hobs]

The solution depends on whether you mean interior color by manual markup or conditional formatting.

[Paul_Hossler]

Teeroy --


if you happen to need finer color control couldn't you replace .Colorindex with .Color?



I guess you could, but RGB(128,128,128) <> RGB(128,128,127) or 8421504 <> 8355968 so I'm not sure if you could rely on it


Paul

[JustGary]

Im sorry, im THAT new at this that it is a foreign language. Im decent at regular excel functions but completely green to VBA. Im having trouble taking the code above and applying it to my sheet. Im hoping someone is feeling charitable and will take pity on me =) and help me out. Any chance I can send you my sheet?

[Paul_Hossler]

Did you down load and look at the SumByColor.xlsm I posted?

Look at the code module in the editor and see if it helps

If you REALLY get stuck, post a small example

Paul

[kssoin]

Hi Paul,
I downloaded the sample file. Can this UDF be used in all workbooks without inserting this module for every workbook?
Regards
K S Soin

[Paul_Hossler]

If you added the module to your Personal.xlsm, it would be available to other workbooks

Paul

[kssoin]

Hi Paul,
I saved the code in a module in a workbook and saved it as Personal.xlsm.
But the sumbycolor function in another workbook returns a #name? error.
I have just started with macros and VBA, pl excuse questions that sound funny.
Regards
K S Soin

[Kenneth Hobs]

Did you change the function name prefix to use it? e.g.
=PERSONAL.XLS!aMin({34,32})

Function aMin(myNums As Variant) As Integer
Dim r As Variant, i As Integer, n() As Variant
i = 0
For Each r In myNums
If r > 0 Then
i = i + 1
ReDim Preserve n(1 To i) As Variant
n(i) = r
End If
Next r
aMin = WorksheetFunction.Min(n)
End Function

[kssoin]

Dear Kenneth,
I did it as you suggested. Thanks for the Tip. I have put in some more UDFs into the module.
Regards.
K s Soin