Sum by font color lags or doesn't stick with respective color

[data808]

I have a template that the user will enter numeric data into cell ranges A1:C10. Numbers will usually range from 1-500. Some cells will also be blank if no data is given to record. Some of the values will be typed in red font color and some will be in black font color. The user may change the data randomly while they use it along with also changing the color of the font on the fly. I have a button for the user that can change the font color between red and black as this spreadsheet is also locked by the traditional method of changing font colors in the ribbon. Here is the code I am using in a module to sum by font color:

Public Function sumRed(r As Range)
Dim ce As Range
sumRed = 0
For Each ce In r
    If ce.Font.ColorIndex = 3 Then sumRed = sumRed + ce.Value
Next ce
End Function

Public Function sumBlack(r As Range)
Dim ce As Range
sumBlack = 0
For Each ce In r
    If ce.Font.ColorIndex = 1 Then sumBlack = sumBlack + ce.Value
Next ce
End Function

Then I have these in cells A15 and C15 respectively:
=sumRed(A1:C10)
=sumBlack(A1:C10)

The problem that seems to be occurring is that the calculation in these cells don't seem to be on the fly or "live" I should say. It is being triggered by some odd events. Like if a cell was set to red because the user had previously typed red font into that cell and now wants to clear it and then change it to black font, it won't add it in C15 for black. It will add it into cell A15 for red because it was originally red. It's as if the calculation is happening before the font changes color. Is there a way to make this method of summing by font color more accurate?

Thanks for the help.

 

[Jimmypop]

Hi there

What happens if you update your formula to the below?

=IF(NOW()>0,sumRed(A1:C10))
=IF(NOW()>0,sumBlack(A1:C10))

 

[data808]

Hi there

What happens if you update your formula to the below?

=IF(NOW()>0,sumRed(A1:C10))
=IF(NOW()>0,sumBlack(A1:C10))

Hi thank you very much for the response. Your functions are very similar. What seems to happen is that if all cells had red font in it and I clear them to start over, then I click the button to change font color to black, then start typing in values, you can literally see the font value initially go into the cell as red but after I hit the enter key it will then change to black and that first cell I start with will sum that value to red because it started off as red. But then all other cells following it will then start to add to the black total. It's very odd. Would you like to see the code I have for the button?

 

[Jimmypop]

Yes please...

 

[data808]

Yes please...

This is in the worksheet change event:

Private Sub Worksheet_Change(ByVal Target As Range)

' checks if cell AZ1 is unlocked. if unlocked then font color is red. if locked then font _
color is black
Dim rng As Range
Dim cell As Range

' See if any cells updates in watched range
Set rng = Intersect(Target, Range("A1:C10"))
If rng Is Nothing Then Exit Sub

' Loop through newly updated cells in watched range
ActiveSheet.Unprotect "hello"
For Each cell In rng
If Range("O1").Locked = False Then
cell.Font.ColorIndex = 3
Else
cell.Font.ColorIndex = xlAutomatic
End If
Next cell
ActiveSheet.Protect "hello"

End Sub




Then I have this in module 1 for the button:

Sub Red_Black_Font()
'
' Red_Black_Font Macro
' switches font color from red to black

ActiveSheet.Unprotect "hello"
Range("O1").Locked = False
ActiveSheet.Shapes.Range(Array("Red Black Font")).Select
If Selection.Characters.Text = "BLACK" Then
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
'.TintAndShade = 0
'.ThemeFont = xlThemeFontMinor
End With
With Selection.Font
.Color = -16776961
'.TintAndShade = 0
End With
Selection.Characters.Text = "RED"
With Selection.Characters(Start:=1, Length:=3).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
ActiveSheet.Protect "hello"
Exit Sub
End If

ActiveSheet.Unprotect "hello"
Range("O1").Locked = True
ActiveSheet.Shapes.Range(Array("Red Black Font")).Select
If Selection.Characters.Text = "RED" Then
With Selection.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
'.TintAndShade = 0
'.ThemeFont = xlThemeFontMinor
End With
With Selection.Font
.ColorIndex = xlAutomatic
'.TintAndShade = 0
End With
Selection.Characters.Text = "BLACK"
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveSheet.Protect "hello"
End If

End Sub




Then I have this in module 2:

Public Function sumRed(r As Range)
Dim ce As Range

sumRed = 0
For Each ce In r
If ce.Font.ColorIndex = 3 Then sumRed = sumRed + ce.Value
Next ce

End Function

Public Function sumBlack(r As Range)
Dim ce As Range

sumBlack = 0
For Each ce In r
If ce.Font.ColorIndex = xlAutomatic Then sumBlack = sumBlack + ce.Value
Next ce

End Function



Then lastly, I have this in cells A15 (red total) and C15 (black total):

=sumRed(A1:C10)
=sumBlack(A1:C10)

I also replaced these with your suggestion with similar results.

 

[Jimmypop]

Some more question... Please maybe provide a layout of your data...

You have

ActiveSheet.Shapes.Range(Array("Red Black Font")

Is this a rectangle or circle? Because I created a shape with this name and all your code for changing font color does is select this shape...

 

[data808]

Some more question... Please maybe provide a layout of your data...

You have

ActiveSheet.Shapes.Range(Array("Red Black Font")

Is this a rectangle or circle? Because I created a shape with this name and all your code for changing font color does is select this shape...

It’s not selecting a shape. It’s just referencing the button that is rectangle and the name of the button is Red Black Font. Lol probably not a very good name but I just needed to understand what it was for.

 

[Jimmypop]

It’s not selecting a shape. It’s just referencing the button that is rectangle and the name of the button is Red Black Font. Lol probably not a very good name but I just needed to understand what it was for.

So the "button" you are using is a rectangle you drew and then you assigned the macro " Sub Red_Black_Font()" to that shape?

I did this just now but your piece of code physically selects the shape and does not change the font color at all... Or maybe I am missing something...

ActiveSheet.Shapes.Range(Array("Red Black Font")).Select 'when I run the code this piece on your code just selects the shape named Red Black Font

 

[data808]

So the "button" you are using is a rectangle you drew and then you assigned the macro " Sub Red_Black_Font()" to that shape?

I did this just now but your piece of code physically selects the shape and does not change the font color at all... Or maybe I am missing something...

ActiveSheet.Shapes.Range(Array("Red Black Font")).Select 'when I run the code this piece on your code just selects the shape named Red Black Font

It changes the text on the button itself. When I click it, it will say Red in red font color on the button. Then if I click again it will change to the word Black in black font color on the button itself. That was just a cosmetic thing I wanted to indicate what color it was on for the user to know what color the font will be when they start typing in values. And yes, the button was drawn with the mouse in a rectangular form.

 

[data808]

So the "button" you are using is a rectangle you drew and then you assigned the macro " Sub Red_Black_Font()" to that shape?

I did this just now but your piece of code physically selects the shape and does not change the font color at all... Or maybe I am missing something...

ActiveSheet.Shapes.Range(Array("Red Black Font")).Select 'when I run the code this piece on your code just selects the shape named Red Black Font

Going to bed now but please post anything you come up with and I will check it at work. Thank you very much for the help on this. You may he my only hope. no one seems to know how to solve this issue.