Refresh cell formula NOT F9

MadeleineB

New Member
Joined
Sep 23, 2008
Messages
18
I have coded my workbook for case formatting and counting total of cells colours, it works BUT I need to select the cells with the formula and manually return to refresh.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
I can get round this by adding a refresh macro that does this but the code not very good. Is there a simple code that I can use instead?
<o:p></o:p>
'Column B<o:p></o:p>
Range("B1").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o:p></o:p>
Range("B2").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o:p></o:p>
<o:p></o:p>
'Column F<o:p></o:p>
Range("F1").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o:p></o:p>
Range("F2").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o:p></o:p>
<o:p></o:p>
'Column H<o:p></o:p>
Range("H1").FormulaR1C1 = "=CountColor(RC,R11C8:R18C8)+(CountColor(RC,R11C10:R15C13)+(CountColor(RC,R21C11:R26C11)))"<o:p></o:p>
<o:p></o:p>
'Totals<o:p></o:p>
Range("B7").FormulaR1C1 = "=IF(R[-6]C>=1,""R"",IF(R[-5]C>=1,""A"",IF(R[-4]C>=1,""P"",IF(R[-3]C=(SUM(R[-6]C:R[-2]C)),""G"",""B""))))"<o:p></o:p>
<o:p></o:p>

The other coding used in the workbook is
<o:p></o:p>
Colour Formatting<o:p></o:p>

<HR align=center width="100%" SIZE=2>

<o:p></o:p>
Option Compare Text 'A=a, B=b, ... Z=z<o:p></o:p>
Option Explicit<o:p></o:p>
<o:p></o:p>
Private Sub Worksheet_Change(ByVal Target As Range)<o:p></o:p>
<o:p></o:p>
Dim Cell As Range<o:p></o:p>
Dim Rng1 As Range<o:p></o:p>
<o:p></o:p>
On Error Resume Next<o:p></o:p>
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)<o:p></o:p>
On Error GoTo 0<o:p></o:p>
If Rng1 Is Nothing Then<o:p></o:p>
Set Rng1 = Range(Target.Address)<o:p></o:p>
Else<o:p></o:p>
Set Rng1 = <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-com:eek:ffice:smarttags" /><st1:place w:st="on">Union</st1:place>(Range(Target.Address), Rng1)<o:p></o:p>
End If<o:p></o:p>
For Each Cell In Rng1<o:p></o:p>
Select Case Cell.Value<o:p></o:p>
<o:p></o:p>
'///////// To clear all other colours??<o:p></o:p>
'Case vbNullString<o:p></o:p>
' Cell.Interior.ColorIndex = xlNone<o:p></o:p>
' Cell.Font.Bold = False<o:p></o:p>
<o:p></o:p>
Case "R"<o:p></o:p>
Cell.Interior.ColorIndex = 3<o:p></o:p>
'Cell.Font.Bold = True<o:p></o:p>
Cell.Font.ColorIndex = 3<o:p></o:p>
<o:p></o:p>
Case "A"<o:p></o:p>
Cell.Interior.ColorIndex = 44<o:p></o:p>
Cell.Font.ColorIndex = 44<o:p></o:p>
<o:p></o:p>
Case "G"<o:p></o:p>
Cell.Interior.ColorIndex = 43<o:p></o:p>
Cell.Font.ColorIndex = 43<o:p></o:p>
<o:p></o:p>
Case "P"<o:p></o:p>
Cell.Interior.ColorIndex = 39<o:p></o:p>
Cell.Font.ColorIndex = 39<o:p></o:p>
<o:p></o:p>
Case "B"<o:p></o:p>
Cell.Interior.ColorIndex = 41<o:p></o:p>
Cell.Font.ColorIndex = 41<o:p></o:p>
<o:p></o:p>
'///////// To clear all other colours??<o:p></o:p>
'Case Else<o:p></o:p>
' Cell.Interior.ColorIndex = xlNone<o:p></o:p>
' Cell.Font.Bold = False<o:p></o:p>
End Select<o:p></o:p>
Next<o:p></o:p>
<o:p></o:p>
End Sub
<o:p></o:p>
Colour Formatting<o:p></o:p>

<HR align=center width="100%" SIZE=2>

<o:p></o:p>
'The following counts cell values based on “fill” colour<o:p></o:p>
<o:p></o:p>
Function CountColor(rColor As Range, rSumRange As Range)<o:p></o:p>
<o:p></o:p>
Dim rCell As Range<o:p></o:p>
Dim iCol As Integer<o:p></o:p>
Dim vResult<o:p></o:p>
<o:p></o:p>
iCol = rColor.Interior.ColorIndex<o:p></o:p>
<o:p></o:p>
For Each rCell In rSumRange<o:p></o:p>
If rCell.Interior.ColorIndex = iCol Then<o:p></o:p>
vResult = vResult + 1<o:p></o:p>
End If<o:p></o:p>
Next rCell<o:p></o:p>
<o:p></o:p>
CountColor = vResult<o:p></o:p>
<o:p></o:p>
End Function
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Just put Application.Volatile after your Function CountColor( row.
 
Upvote 0
Where abouts please? I tried below and it did not work.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
 
Last edited:
Upvote 0
Rich (BB code):
Function CountColor(rColor As Range, rSumRange As Range)
Application.Volatile
Dim rCell As Range
Dim iCol As Integer
Dim vResult

iCol = rColor.Interior.ColorIndex

For Each rCell In rSumRange
If rCell.Interior.ColorIndex = iCol Then
vResult = vResult + 1
End If
Next rCell

CountColor = vResult

End Function

Also put a "Calculate" into your Worksheet_Change module ... it's the recalculation being forced that should fix things.
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,649
Messages
6,120,733
Members
448,987
Latest member
marion_davis

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
Back
Top