Visual Basic Private Sub Worksheet_Change Conditional Formats on Multiple Ranges

[BexsterBlonde]

Hi,

I am trying to set up some Conditional Formats through Code on the Worksheet_Change as I need to setup 4 different Conditions in Excel 2003. Also, the Conditional Formats are different for each Column within the Worksheet. I have managed to setup One Range to change, but I cannot workout how to set up more than One Range. Please can someone help? The below code currently works, but I need to add in different Case Conditional Formats for Columns G2:G250, H2:H250, I2:I250 - how do I do this?

Private Sub Worksheet_Change(ByVal Target As Range)<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><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 = Range("F2:F250").Select<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>
Case 0.00001 To 69.99999<o></o>
Target.Interior.ColorIndex = 3<o></o>
<o></o>
Case 70 To 79.99999<o></o>
Target.Interior.ColorIndex = 45<o></o>
<o></o>
Case 80 To 100<o></o>
Target.Interior.ColorIndex = 43<o></o>
<o></o>
Case 0<o></o>
Target.Interior.ColorIndex = 56<o></o>
Target.Font.ColorIndex = 2<o></o>
<o></o>
Case Else<o></o>
Target.Interior.ColorIndex = 15<o></o>
<o></o>
End Select<o></o>
Next<o></o>
<o></o>
End Sub

 

[AlphaFrog]

Try something like this. I used the same the conditions for the different columns. You have to change that to your liking.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range
    
    If Not Intersect(Target, Range("F2:F250")) Is Nothing Then
        For Each Cell In Intersect(Target, Range("F2:F250"))
        
            Select Case Cell.Value
            
                Case 0.00001 To 69.99999
                    Cell.Interior.ColorIndex = 3
                
                Case 70 To 79.99999
                    Cell.Interior.ColorIndex = 45
                
                Case 80 To 100
                    Cell.Interior.ColorIndex = 43
                
                Case 0
                    Cell.Interior.ColorIndex = 56
                    Cell.Font.ColorIndex = 2
                
                Case Else
                    Cell.Interior.ColorIndex = 15
            
            End Select
        Next Cell
    End If
    
    If Not Intersect(Target, Range("G2:G250")) Is Nothing Then
        For Each Cell In Intersect(Target, Range("G2:G250"))
        
            Select Case Cell.Value
            
                Case 0.00001 To 69.99999
                    Cell.Interior.ColorIndex = 3
                
                Case 70 To 79.99999
                    Cell.Interior.ColorIndex = 45
                
                Case 80 To 100
                    Cell.Interior.ColorIndex = 43
                
                Case 0
                    Cell.Interior.ColorIndex = 56
                    Cell.Font.ColorIndex = 2
                
                Case Else
                    Cell.Interior.ColorIndex = 15
            
            End Select
        Next Cell
    End If

    If Not Intersect(Target, Range("H2:H250")) Is Nothing Then
        For Each Cell In Intersect(Target, Range("H2:H250"))
        
            Select Case Cell.Value
            
                Case 0.00001 To 69.99999
                    Cell.Interior.ColorIndex = 3
                
                Case 70 To 79.99999
                    Cell.Interior.ColorIndex = 45
                
                Case 80 To 100
                    Cell.Interior.ColorIndex = 43
                
                Case 0
                    Cell.Interior.ColorIndex = 56
                    Cell.Font.ColorIndex = 2
                
                Case Else
                    Cell.Interior.ColorIndex = 15
            
            End Select
        Next Cell
    End If

    If Not Intersect(Target, Range("I2:I250")) Is Nothing Then
        For Each Cell In Intersect(Target, Range("I2:I250"))
        
            Select Case Cell.Value
            
                Case 0.00001 To 69.99999
                    Cell.Interior.ColorIndex = 3
                
                Case 70 To 79.99999
                    Cell.Interior.ColorIndex = 45
                
                Case 80 To 100
                    Cell.Interior.ColorIndex = 43
                
                Case 0
                    Cell.Interior.ColorIndex = 56
                    Cell.Font.ColorIndex = 2
                
                Case Else
                    Cell.Interior.ColorIndex = 15
            
            End Select
        Next Cell
    End If

End Sub

 

[BexsterBlonde]

Thank you! That has helped me a lot.