Reputation: 23
I'm trying to find a solution to automatically recalculate a VBA formula once I change the color of the cell
Function SumColorColumns11(sumRange As Range) As Double
Dim cell As Range
For Each cell In sumRange
If cell.Interior.Color = 12611584 And cell.Column = 7 Then
SumColorColumns11 = SumColorColumns11 + 20
ElseIf cell.Interior.Color = 12611584 And cell.Column = 8 Then
SumColorColumns11 = SumColorColumns11 + 30
End If
Next cell
SumColorColumns11 = SumColorColumns11 / 100
Currently when I want to recalculate the VBA formula I go to a cell that has the formula and click on the then formula then press enter.
After editing it
Function SumColorColumns11(sumRange As Range) As Double
Dim cell As Range
For Each cell In sumRange
If cell.Interior.Color = 12611584 And cell.Column = 7 Then
SumColorColumns11 = SumColorColumns11 + 20
ElseIf cell.Interior.Color = 12611584 And cell.Column = 8 Then
SumColorColumns11 = SumColorColumns11 + 30
cell.Calculate
End If
Next cell
SumColorColumns11 = SumColorColumns11 / 100
I have found other solution to Run a Macro when a User Changes, but I don't know how to apply it on my function as it receive an range and return a value.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C6:R393")) Is Nothing Then
MsgBox "hi"
End If
End Sub
Upvotes: 1
Views: 924
Reputation: 1491
Your problem is that, there is no event fired when the cell color is changed, also a recalculate does not work on the UDF - as you say you have to manually trigger it - so I suspect the best you can do is to call a one liner of your code from some other frequently triggered event - I suggest the SelectionChange event - as follows
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Change A1 in the following to the Cell you want the result in
Range("A1").Value = SumColorColumns11(Range("G1:H9")) ' Change G1:H9 to your own range here
End Sub
Then just moving to a different cell will trigger it after you change the color - not ideal of course, so not the answer you're looking for, but it's a crude workaround.
++++++++++++++++++++++++++++ ADDED ++++++++++++++++++++++++++++++++++
The following added in response to your comment for values in multiple rows and to reduce the frequency of calling the routine
Put this in the Sheets Module Declaration Area
Public LastRng As Range, CalledB4 As Boolean
Then this is the modified SelectionChange Event Code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
' This routine will write a value into Column A that is the sum of the colors in cells G & H of the same row
' It only calls your SumColorColumns11 when we moved out of a cell in the WatchRng (G2:H12)
'
Const WatchRng As String = "G2:H12"
Dim xCel As Range, Rng2Chek As Range
If Not (CalledB4 = True) Then
CalledB4 = True
Else
If Not Application.Intersect(Range(WatchRng), LastRng) Is Nothing Then
For Each xCel In Application.Intersect(Range(WatchRng), LastRng).Cells
' The following line checks Columns G&H of the same row as xCel - for a different range change G & H
Set Rng2Chek = Range("G" & xCel.Row & ":H" & xCel.Row)
' The 1 in the following line means put result in column A - use 2 for B, 3 for C etc
xCel.Offset(0, 1 - xCel.Column).Value = SumColorColumns11(Rng2Chek)
Next xCel
End If
End If
Set LastRng = Target
End Sub
Upvotes: 1
Reputation: 14373
There are so many ways of setting a cell's interior colour and the methods I tried to develop to find out if one of them was applied all ended up being more voluminous than the simplest of all solutions, which is to calculate the totals frequently. The event procedure below does that - almost. Please try it.
Install the procedure below in the code module of the worksheet on which you want the action (Not the module in which your UDF resides!)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WatchCol As Long = 12611584
Const WatchRng As String = "G2:H12"
Const ResultRng As String = "G13:H13"
If Not Application.Intersect(Range(WatchRng), Target) Is Nothing Then
Range(ResultRng).Calculate
End If
End Sub
There are two ranges to define. The WatchRng
is equal to your function's SumRange. My procedure will respond to clicks in that range. The ResultRng
is the range to be recalculated. It's where your UDFs are being called. In fact, this range will be recalculated every time you click anywhere in the WatchRng
. However, it's possible to change a cell's colour without clicking anything. In such cases the next click within the WatchRng
will trigger the calculation. Accepting this flaw is less burdensome, I judged, than having a long procedure running at every click that would cure the flaw but make your sheet react sluggishly.
While trying out many ideas I also reviewed your UDF. Since it will be called more often I tried to streamline it. However, it has no functionality your own design doesn't also have.
Function SumColorColumns11(SumRange As Range) As Double
Dim Fun As Double
Dim Cell As Range
For Each Cell In SumRange
If Cell.Interior.Color = 12611584 Then
On Error Resume Next
Fun = Fun + Array(0.2, 0.3)(Cell.Column - 7)
End If
Next Cell
SumColorColumns11 = Fun
End Function
Upvotes: 0