asked on

Macro for conditional formatting using Worksheet_Calculate()

Hi!

I have a Column K containing values from 0.1 to 20. I would like to color these cells individually based on the value of the cell. The value of the cells in column K is calculated using a forumla (multiplying the cells in column I by the cells in column J).

Everytime I update one of the cells in column I or J the value changes and I would like the cell color to change as well (if applicable).

I have found/modified the attached formula but whenever I expand or collapse groups of rows I get runtime errors.

Thanks :)

Private Sub Worksheet_Calculate()
Dim rngMyRange As Range, rngCell As Range

Set rngMyRange = Range("K8:K100")

'define range, limiting cells to only those with formulae
For Each rngCell In rngMyRange.SpecialCells(xlCellTypeFormulas)

    Select Case rngCell.Value
        Case 0.1 To 5.9:
        rngCell.Interior.Color = RGB(146, 208, 80)
        rngCell.Font.Color = RGB(146, 208, 80)
        Case 6 To 7.9:
        rngCell.Interior.Color = RGB(255, 255, 102)
        rngCell.Font.Color = RGB(255, 255, 102)
        Case 8 To 10:
        rngCell.Interior.Color = RGB(192, 80, 77)
        rngCell.Font.Color = RGB(192, 80, 77)
        Case 10.1 To 15.9:
        rngCell.Interior.Color = RGB(197, 217, 241)
        rngCell.Font.Color = RGB(197, 217, 241)
        Case 16 To 17.9:
        rngCell.Interior.Color = RGB(141, 180, 226)
        rngCell.Font.Color = RGB(141, 180, 226)
        Case 18 To 20:
        rngCell.Interior.Color = RGB(197, 217, 241)
        rngCell.Font.Color = RGB(197, 217, 241)
        Case Else:
        rngCell.Interior.Color = RGB(255, 255, 255)
        rngCell.Font.Color = RGB(255, 255, 255)
    End Select
Next
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Norie

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

cegeland

ASKER

Thanks for your suggestion. This cleared the error when expanding/collapsing groups.
But when I insert a new row (using attached macro) i now get an error message:
"Application-defined or object-defined error" on the following line:
Set rngCell = Target.Offset(, 11 - Target.Column)

' macro for inserting new row
Sub InsertARow()
     'make new row
    ActiveCell.EntireRow.Insert shift:=xlUp
     'copy the row above
    ActiveCell.Offset(1, 0).EntireRow.Copy Cells(ActiveCell.Row, 1)
    On Error Resume Next
     'clear every cell in the new line that does not have a formula
    ActiveCell.EntireRow.SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub