maram
maram

Reputation: 23

Recalculate VBA formula excel

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

Answers (2)

Tin Bum
Tin Bum

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

Variatus
Variatus

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

Related Questions