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-comfficeffice" /><o></o>
<o></o>
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></o>
'Column B<o></o>
Range("B1").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o></o>
Range("B2").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o></o>
<o></o>
'Column F<o></o>
Range("F1").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o></o>
Range("F2").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o></o>
<o></o>
'Column H<o></o>
Range("H1").FormulaR1C1 = "=CountColor(RC,R11C8:R18C8)+(CountColor(RC,R11C10:R15C13)+(CountColor(RC,R21C11:R26C11)))"<o></o>
<o></o>
'Totals<o></o>
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></o>
<o></o>
The other coding used in the workbook is
<o></o>
Colour Formatting<o></o>
<o></o>
Option Compare Text 'A=a, B=b, ... Z=z<o></o>
Option Explicit<o></o>
<o></o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
<o></o>
Dim Cell As Range<o></o>
Dim Rng1 As Range<o></o>
<o></o>
On Error Resume Next<o></o>
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)<o></o>
On Error GoTo 0<o></o>
If Rng1 Is Nothing Then<o></o>
Set Rng1 = Range(Target.Address)<o></o>
Else<o></o>
Set Rng1 = <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on">Union</st1lace>(Range(Target.Address), Rng1)<o></o>
End If<o></o>
For Each Cell In Rng1<o></o>
Select Case Cell.Value<o></o>
<o></o>
'///////// To clear all other colours??<o></o>
'Case vbNullString<o></o>
' Cell.Interior.ColorIndex = xlNone<o></o>
' Cell.Font.Bold = False<o></o>
<o></o>
Case "R"<o></o>
Cell.Interior.ColorIndex = 3<o></o>
'Cell.Font.Bold = True<o></o>
Cell.Font.ColorIndex = 3<o></o>
<o></o>
Case "A"<o></o>
Cell.Interior.ColorIndex = 44<o></o>
Cell.Font.ColorIndex = 44<o></o>
<o></o>
Case "G"<o></o>
Cell.Interior.ColorIndex = 43<o></o>
Cell.Font.ColorIndex = 43<o></o>
<o></o>
Case "P"<o></o>
Cell.Interior.ColorIndex = 39<o></o>
Cell.Font.ColorIndex = 39<o></o>
<o></o>
Case "B"<o></o>
Cell.Interior.ColorIndex = 41<o></o>
Cell.Font.ColorIndex = 41<o></o>
<o></o>
'///////// To clear all other colours??<o></o>
'Case Else<o></o>
' Cell.Interior.ColorIndex = xlNone<o></o>
' Cell.Font.Bold = False<o></o>
End Select<o></o>
Next<o></o>
<o></o>
End Sub
<o></o>
Colour Formatting<o></o>
<o></o>
'The following counts cell values based on “fill” colour<o></o>
<o></o>
Function CountColor(rColor As Range, rSumRange As Range)<o></o>
<o></o>
Dim rCell As Range<o></o>
Dim iCol As Integer<o></o>
Dim vResult<o></o>
<o></o>
iCol = rColor.Interior.ColorIndex<o></o>
<o></o>
For Each rCell In rSumRange<o></o>
If rCell.Interior.ColorIndex = iCol Then<o></o>
vResult = vResult + 1<o></o>
End If<o></o>
Next rCell<o></o>
<o></o>
CountColor = vResult<o></o>
<o></o>
End Function
<o></o>
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></o>
'Column B<o></o>
Range("B1").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o></o>
Range("B2").FormulaR1C1 = "=CountColor(RC,R10C2:R202C2)"<o></o>
<o></o>
'Column F<o></o>
Range("F1").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o></o>
Range("F2").FormulaR1C1 = "=CountColor(RC,R10C6:R202C6)"<o></o>
<o></o>
'Column H<o></o>
Range("H1").FormulaR1C1 = "=CountColor(RC,R11C8:R18C8)+(CountColor(RC,R11C10:R15C13)+(CountColor(RC,R21C11:R26C11)))"<o></o>
<o></o>
'Totals<o></o>
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></o>
<o></o>
The other coding used in the workbook is
<o></o>
Colour Formatting<o></o>
<HR align=center width="100%" SIZE=2>
<o></o>
Option Compare Text 'A=a, B=b, ... Z=z<o></o>
Option Explicit<o></o>
<o></o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
<o></o>
Dim Cell As Range<o></o>
Dim Rng1 As Range<o></o>
<o></o>
On Error Resume Next<o></o>
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)<o></o>
On Error GoTo 0<o></o>
If Rng1 Is Nothing Then<o></o>
Set Rng1 = Range(Target.Address)<o></o>
Else<o></o>
Set Rng1 = <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on">Union</st1lace>(Range(Target.Address), Rng1)<o></o>
End If<o></o>
For Each Cell In Rng1<o></o>
Select Case Cell.Value<o></o>
<o></o>
'///////// To clear all other colours??<o></o>
'Case vbNullString<o></o>
' Cell.Interior.ColorIndex = xlNone<o></o>
' Cell.Font.Bold = False<o></o>
<o></o>
Case "R"<o></o>
Cell.Interior.ColorIndex = 3<o></o>
'Cell.Font.Bold = True<o></o>
Cell.Font.ColorIndex = 3<o></o>
<o></o>
Case "A"<o></o>
Cell.Interior.ColorIndex = 44<o></o>
Cell.Font.ColorIndex = 44<o></o>
<o></o>
Case "G"<o></o>
Cell.Interior.ColorIndex = 43<o></o>
Cell.Font.ColorIndex = 43<o></o>
<o></o>
Case "P"<o></o>
Cell.Interior.ColorIndex = 39<o></o>
Cell.Font.ColorIndex = 39<o></o>
<o></o>
Case "B"<o></o>
Cell.Interior.ColorIndex = 41<o></o>
Cell.Font.ColorIndex = 41<o></o>
<o></o>
'///////// To clear all other colours??<o></o>
'Case Else<o></o>
' Cell.Interior.ColorIndex = xlNone<o></o>
' Cell.Font.Bold = False<o></o>
End Select<o></o>
Next<o></o>
<o></o>
End Sub
<o></o>
Colour Formatting<o></o>
<HR align=center width="100%" SIZE=2>
<o></o>
'The following counts cell values based on “fill” colour<o></o>
<o></o>
Function CountColor(rColor As Range, rSumRange As Range)<o></o>
<o></o>
Dim rCell As Range<o></o>
Dim iCol As Integer<o></o>
Dim vResult<o></o>
<o></o>
iCol = rColor.Interior.ColorIndex<o></o>
<o></o>
For Each rCell In rSumRange<o></o>
If rCell.Interior.ColorIndex = iCol Then<o></o>
vResult = vResult + 1<o></o>
End If<o></o>
Next rCell<o></o>
<o></o>
CountColor = vResult<o></o>
<o></o>
End Function