Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA conditional formatting with a formula 2

Status
Not open for further replies.

zebra99

Technical User
Sep 19, 2008
14
US
The code I found below works great except I need the case or lookup to be based on the sum of the active cell and the previous 5 cells. This is similar to the Formula Is function of traditional conditional formatting. How would this be incorporated to the code below?


Private Sub Worksheet_Calculate()
Dim oCell As Rang
For Each oCell In Range("A1:A20")
Select Case oCell.Value
Case Is < 1
oCell.Interior.ColorIndex = xlNone
Case Is = 1
oCell.Interior.ColorIndex = 5
Case Is = 2
oCell.Interior.ColorIndex = 3
Case Is = 3
oCell.Interior.ColorIndex = 6
Case Is = 4
oCell.Interior.ColorIndex = 4
Case Is = 5
oCell.Interior.ColorIndex = 7
Case Is = 6
oCell.Interior.ColorIndex = 15
Case Is = 7
oCell.Interior.ColorIndex = 40
Case Is > 7
oCell.Interior.ColorIndex = xlNone
End Select
Next oCell
End Sub


Thanks in advance for your help!
 




How can the range start in A1 and you have ANY previous cells???

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Sorry, this was an example. The range is H29:Z40.
 
Private Sub Worksheet_Calculate()
Dim oCell As Rang
For Each oCell In Range("H29:Z40")
myTot = oCell.Value
For i = 1 To 5
myTot = myTot + oCell.Offset(-i, 0).Value
Next i
Select Case myTot
Case Is < 1
oCell.Interior.ColorIndex = xlNone
Case Is = 1
oCell.Interior.ColorIndex = 5
Case Is = 2
oCell.Interior.ColorIndex = 3
Case Is = 3
oCell.Interior.ColorIndex = 6
Case Is = 4
oCell.Interior.ColorIndex = 4
Case Is = 5
oCell.Interior.ColorIndex = 7
Case Is = 6
oCell.Interior.ColorIndex = 15
Case Is = 7
oCell.Interior.ColorIndex = 40
Case Is > 7
oCell.Interior.ColorIndex = xlNone
End Select
Next oCell
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
PHV, thanks for the help, your version worked, but I had to make some changes to the code and now I get a runtime 1004 error. Any ideas? Below is what I changed the code to.


Private Sub Worksheet_Calculate()
Dim oCell As Range
For Each oCell In Range("H2:Z22")
myTot = oCell.Value
For i = 1 To 5
myTot = myTot + oCell.Offset(-i, 0).Value
Next i
Select Case myTot
Case Is < 3
oCell.Interior.ColorIndex = xlNone
Case Is = 3
oCell.Interior.ColorIndex = 6
Case Is = 4
oCell.Interior.ColorIndex = 45
Case Is = 5
oCell.Interior.ColorIndex = 3
Case Is > 5
oCell.Interior.ColorIndex = 39
End Select
Next oCell
End Sub
 




Range("H2:Z22")

H2: 5 cells BEFORE????????

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 




that is NOT what you requested!!! The understanding is that previous values are from the same COLUMN, whic is EXACLY what both PHV and I assumed.

Please explain IN FULL DETAIL, what you are trying to acccomplish, and please do not repeat what you have already stated. Please state the BUISINSS CASE for this request.



Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
I figured it out, it was looking vertical verses horizontal, one line needed to be changed.

New Line

myTot = myTot + oCell.Offset(0, -i).Value

One final question, how do I make the color update upon data entry in the cell?
 




use the worksheet_change event.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 




You might want to use your procedure to initialize and this one to reflect changes...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect([FormatRange], Target) Is Nothing Then
        Select Case Application.Sum(Target.Offset(0, -5), Target)
             Case Is < 1
                 Target.Interior.ColorIndex = xlNone
             Case Is = 1
                 Target.Interior.ColorIndex = 5
             Case Is = 2
                 Target.Interior.ColorIndex = 3
             Case Is = 3
                 Target.Interior.ColorIndex = 6
             Case Is = 4
                 Target.Interior.ColorIndex = 4
             Case Is = 5
                 Target.Interior.ColorIndex = 7
             Case Is = 6
                 Target.Interior.ColorIndex = 15
             Case Is = 7
                 Target.Interior.ColorIndex = 40
             Case Is > 7
                 Target.Interior.ColorIndex = xlNone
         End Select
    End If
End Sub


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 




BTW, FormatRange is you defined as H2:Z22 in the Excel Name Box.

This ought to work on ANY change on a row...
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    For Each r In Intersect([FormatRange], Target.EntireRow)
        With r
            Select Case Application.Sum(.Offset(0, -5), .Value)
                 Case Is < 1, Is >= 8
                     .Interior.ColorIndex = xlNone
                 Case Is < 2
                     .Interior.ColorIndex = 5
                 Case Is < 3
                     .Interior.ColorIndex = 3
                 Case Is < 4
                     .Interior.ColorIndex = 6
                 Case Is < 5
                     .Interior.ColorIndex = 4
                 Case Is < 6
                     .Interior.ColorIndex = 7
                 Case Is < 7
                     .Interior.ColorIndex = 15
                 Case Is < 8
                     .Interior.ColorIndex = 40
             End Select
        End With
    Next
End Sub

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Skip,

Thanks for the help, sorry for the mixup earlier. This is the first time I have ever used VBA.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top