Sum in Code VBA

Here's one way to do it

Let's say your range starts in A2, this code will sum the values in cells where the font color is black. It will stop counting when the font index is Automatic. As you can see, this code is a bit on the awkward side because it includes a deletion of values in column B at the start (modify as needed depending on your expected range), which is necessary in case you change font colors from time to time in the same range, enabling you to always get an accurate current sum. Also, it includes a loop structure, which I'm generally not crazy about but in this case does the job.

Sub SumFontColor()
Application.ScreenUpdating = False
Columns("B:B").ClearContents
Range("A2").Activate
Do Until ActiveCell.Font.ColorIndex = xlAutomatic
If ActiveCell.Font.ColorIndex = 1 Then
ActiveCell.Offset(0, 1).Value = ActiveCell.Value
End If
ActiveCell.Offset(1, 0).Activate
Loop
ActiveCell.Offset(0, 1).Formula = "=SUM(R2C2:R[-1]C)"
Application.ScreenUpdating = True
End Sub

Good luck, hope this helps.

Tom Urtis

Try this function (not tested) .....

Function SumBlk(rng As range)
Dim cell As range, x As Integer, tot As Double
x = 0
For Each cell In rng
If IsNumeric(cell) Then
If cell.Font.ColorIndex = 1 Then
If x > 0 Then
tot = tot + cell.Value
Else
tot = cell.Value
x = 1
End If
End If
End If
Next
SumBlk = tot
End Function

You could try the following UDF. The second argument is the colour you want to sum. In Excel 97, 3 is red for example. So =SUMCOLOUR(A1:A3,3) will sum all the red cells in A1:A3. You could change it so you can pass in colour names (like "red" for example) and the function does the conversion.

Whether this works depends how the colour of the cell is set. If, for example, the cell is red because it is a negative number and the number format is set to show negative numbers in red this won't work.

Another problem is forcing the function to recalculate when someone changes a cell's colour. Even Application.Volatile won't necessarily work in this case as that only recalculates when the worksheet gets recalculated. Changing a cells colour doesn't cause this.

Function SumColour(rngSum As Range, varColour As Variant) As Variant

Dim rngCell As Range

For Each rngCell In rngSum.Cells
If rngCell.Font.ColorIndex = varColour Then
SumColour = SumColour + rngCell.Value
End If
Next rngCell

End Function

Gary

Hi Gary
Works fine, i understood the dangers, but i alone use my sheets and it a guild not hard fast data reports, so my maintance will be perfact an your code will do just as io need, best i find a font cart.

BTW I use blue for red as reds taken as you point out also Blues easier to see i find, just a tip inthe finance world.
Cheers Jack

Cheers all ive lots to go on a big thanks, now all i have to do is play and get all trhe font colours listed for reference

Thanks again