range question

[aubbus]

I have this code modified for my needs. But I am wondering how can this be restricted to particular cell range? for Eg., Cell L10 to L200
Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Not Started"
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = False
Case "Completed"
Cell.Interior.ColorIndex = 4
Cell.Font.Bold = False
Case "On Hold"
Cell.Interior.ColorIndex = 5
Cell.Font.Bold = False
Case "In Progress"
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = False
Case "Not Applicable"
Cell.Interior.ColorIndex = 16
Cell.Font.Bold = False
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

 

[bensonsearch]

instead of getting range based on special cells or whatever you can set it by

Rng1 = thisworkbook.sheets("Sheet1").range("a1:b1").value

change ranges and sheet as needed

 

[Norie]

Not 100% sure what you mean but if you want to check that the cell that has been changed is in the range L10:L200.

If Intersect(Target, Range("L10:L200")) Is Nothing Then Exit Sub

 

[aubbus]

Thanks Bensonsearch and Norie for your updates. When I set the range as you mentioned, it still doesn't do it.

To explain the problem better, I wanted to color the cells based on text but then I dont want the whole worksheet to change.

With my old code Rng1 set to specialcells it would work but do it for the whole excel sheet. For eg., if I type "Not Started" in any cell, it would turn red, even though I dont want to do on some cells. So I was wondering if the code could be limited to only particular cell range.

 

[Norie]

The code I posted will only work if the change is made in L10:L200, but it will only work for the cell that has been changed.

If you want the code to run for all the entire range whenever any cell is changed in it:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim rng As Range
 
    Set rng = Range("L10:L200")
    
    If Intersect(rng, Target) Is Nothing Then Exit Sub
    
    For Each cl In rng

        Select Case cl.Value
            Case vbNullString
                cl.Interior.ColorIndex = xlNone
                cl.Font.Bold = False
            Case "Not Started"
                cl.Interior.ColorIndex = 3
                cl.Font.Bold = False
            Case "Completed"
                cl.Interior.ColorIndex = 4
                cl.Font.Bold = False
            Case "On Hold"
                cl.Interior.ColorIndex = 5
                cl.Font.Bold = False
            Case "In Progress"
                cl.Interior.ColorIndex = 6
                cl.Font.Bold = False
            Case "Not Applicable"
                cl.Interior.ColorIndex = 16
                cl.Font.Bold = False
            Case Else
                cl.Interior.ColorIndex = xlNone
                cl.Font.Bold = False
        End Select
    Next
 
End Sub

 

[aubbus]

Thanks Norie. That worked perfectly. This is much easier than passing range for the function. Simple at its best.

 

[Norie]

That should have been:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim rng As Range
 
    Set rng = Range("L10:L200")
    
    If Intersect(rng, Target) Is Nothing Then Exit Sub
    
    For Each cl In rng
        Select Case cl.Value
            Case vbNullString
                cl.Interior.ColorIndex = xlNone
                cl.Font.Bold = False
            Case "Not Started"
                cl.Interior.ColorIndex = 3
                cl.Font.Bold = False
            Case "Completed"
                cl.Interior.ColorIndex = 4
                cl.Font.Bold = False
            Case "On Hold"
                cl.Interior.ColorIndex = 5
                cl.Font.Bold = False
            Case "In Progress"
                cl.Interior.ColorIndex = 6
                cl.Font.Bold = False
            Case "Not Applicable"
                cl.Interior.ColorIndex = 16
                cl.Font.Bold = False
            Case Else
                cl.Interior.ColorIndex = xlNone
                cl.Font.Bold = False
        End Select
    Next
End Sub

Which is exactly the same but indented.