Sums by font color with auto recalc UDF

bbaker0718

New Member
Joined
Dec 5, 2018
Messages
3
I'm trying to set up a spreadsheet to help keep track of plugged numbers with subcontractors and my own estimating teams numbers.

we are keeping track of the numbers by colored font. light blue, red and black.
light blue is from our numbers, red is values that the sub is missing and black is the base number of the proposal.

after searching forums and google, I've come up with the UDF for sumbycolorfont which worked great, if i want to press f9 each time, i have 64 sheets i need this to work on, and that becomes an issue with multiple people adding numbers and using this file as reference, as i'm sure someone will forget to recalc and take the numbers for face value. so i started to look for a way to auto calc after the color change event. i found someone's advice for adding a SelectionChange event and tried it, that works great, however now i can't copy/paste anything as selecting a new cell activates the auto calc and my clipboard gets erased.

here are the udf's i'm using. how can i combine these or reorder the recalc command to the color change event only that allows me copy/paste, auto updates the formula and recognizes the font color change.

Function SumCellsByFontColor(rData As Range, cellRefColor As Range)
Dim indRefColor As Long
Dim cellCurrent As Range
Dim sumRes
Application.Volatile (True)
sumRes = 0
indRefColor = cellRefColor.Cells(1, 1).Font.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Font.Color Then
sumRes = WorksheetFunction.Sum(cellCurrent, sumRes)
End If
Next cellCurrent
SumCellsByFontColor = sumRes
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Me.Calculate
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Me.Calculate
End Sub


the sumbyfontcolor is on the workbook module and the me.calculate is on each sheet 1-64.

i'm new when it comes to this, so my understanding of how these things work is limited. any help would be greatly appreciated

p.s. if this has been talked about already, i'm sorry for posting a new post. after two days of searching, I've resorted to asking outright. If this has been covered, please if you could redirect me to the original post and i'll follow up there.
thank you,
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

dUBBINS

Well-known Member
Joined
Feb 9, 2015
Messages
504
There are surely more elegant solutions, however, if your copy/paste is done via VBA, you can wrap that code in

APPLICATION.ENABLEEVENTS = FALSE
copy/paste code
APPLICATION.ENABLEEVENTS= TRUE

Or put each in it's own sub routine and use a button to turn your event change on and off.

Hopefully someone gives you better advice, but I think that would work.
 

bbaker0718

New Member
Joined
Dec 5, 2018
Messages
3
Thank you, I'll give that a try tomorrow when I get to work. I know there is a way to use formulas to sum by color code, but until this evening I didn't have the color codes. I've found the right codes now, but do not know the formula to sum by color codes.

if this is a possible solution to my issue and I can avoid this cluster of workarounds, I would greatly appreciate help with that formula if anyone knows it.

my goal is to sum the colors light blue and red while subtracting black. the black numbers will be summed separately then both those totals (colored + black) would be summed as a total. my head hurts trying to do all this lol.. thank you in advance for any help that is given. I do appreciate it.
 

bbaker0718

New Member
Joined
Dec 5, 2018
Messages
3
I was able to find a solution and I wanted to post it in here just in case anyone else is searching for auto calc color change events with summing colored fonts

add a new module and paste this code into it

Code:
Function SumRed(MyRange As Range)

Application.Volatile (True)

    SumRed = 0
    For Each cell In MyRange
        If cell.Font.Color = 255 Then
            SumRed = SumRed + cell.Value
        End If
    Next cell
End Function

Function SumLightBlue(MyRange As Range)

Application.Volatile (True)

    SumLightBlue = 0
    For Each cell In MyRange
        If cell.Font.Color = 15773696 Then
            SumLightBlue = SumLightBlue + cell.Value
        End If
    Next cell
End Function

I used the color code to make the macro i was previously trying to use smaller and easier to add more font colors if needed.

To find the color code, open your visual viewer and press Ctrl+G to open the immediate viewer and type this into the field: print activecell.Font.Color make sure the cell you want to find the color for is selected and press enter. with each cell that is selected before pressing enter, it will give you the font code. replace the code in UDF (If cell.Font.Color = "Color Code" Then) - change the function name and rename the SumColor = SumColor + cell.Value line with the respective label you choose

Now, to have excel auto recalc the color change event if you were to type a name or number then assign a color, you need to add this code to the Sheet (Code)

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Me.Range("F13:F76").Calculate
End Sub

this will need to be added to each sheet that you're wanting to sum colored fonts and the range will need to be defined. this will increase recalc times but with my 64 sheets its up to 1/2 to 1 sec extra time which is barely noticed.
selecting another cell will update the event change and calculate your change.

The simplest way to get past adding the code to each sheet is just to press F9 to manually recalc, but I've found that people are forgetful creatures and with reports or updates needed on the fly, someone will forget to press F9.

I've tried to use =RAND() to influence a event change, but i was unsuccessful, though it works well with interior cell color i could not get it to work for font color.

perhaps some of the experts out there can come up with another way, until then, this is a viable solution to recalcing an event change.

I hope it helps.
 

Forum statistics

Threads
1,186,059
Messages
5,955,613
Members
438,205
Latest member
gaose77777

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top