VBA format based on condition?

[simi_uk]

Firstly, thanks for taking time out to read this.

Secondly, I hope you can help!

I'm trying to colour columns 'A' thru 'O', based upon data entered in cell K.

Currently, I've got the following code made up to do this, but it colours all cells from A through IV on that row. Is it possible to amend it so that the range is restricted to only cells 'A' through 'O' on that row?

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [K3:K9999]) Is Nothing Then
    If Target.Value = "section 1" Then
    Target.EntireRow.Interior.ColorIndex = 15
    ElseIf Target.Value = "section 2" Then
    Target.EntireRow.Interior.ColorIndex = 42
    ElseIf Target.Value = "Structures Bay" Then
    Target.EntireRow.Interior.ColorIndex = 7
    ElseIf Target.Value = "section 3a" Or Target.Value = "section 3b" Then
    Target.EntireRow.Interior.ColorIndex = 6
    ElseIf Target.Value = "section 4" Then
    Target.EntireRow.Interior.ColorIndex = 10
    Else: Target.EntireRow.Interior.ColorIndex = xlNone
    End If
End If
End Sub

 

[Zack Barresse]

Hi there,

Yes, try this ...




<font face=Courier New><SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> Worksheet_Change(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range)<br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> Intersect(Target, Me.Range("K3:K9999")) <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> Target.Value = "section 1" <SPAN style="color:#00007F">Then</SPAN><br>            Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 15<br>        <SPAN style="color:#00007F">ElseIf</SPAN> Target.Value = "section 2" <SPAN style="color:#00007F">Then</SPAN><br>            Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 42<br>        <SPAN style="color:#00007F">ElseIf</SPAN> Target.Value = "Structures Bay" <SPAN style="color:#00007F">Then</SPAN><br>            Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 7<br>        <SPAN style="color:#00007F">ElseIf</SPAN> Target.Value = "section 3a" <SPAN style="color:#00007F">Or</SPAN> Target.Value = "section 3b" <SPAN style="color:#00007F">Then</SPAN><br>            Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 6<br>        <SPAN style="color:#00007F">ElseIf</SPAN> Target.Value = "section 4" <SPAN style="color:#00007F">Then</SPAN><br>            Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 10<br>        Else: Me.Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = xlNone<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[simi_uk]

wow, that was...err, quick!

Thanks Zack, i'll see how i go with that

 

[Jonmo1]

Try
Range("A" & Target.Row).Resize(1,15).Interior.Colorindex = 15

Also
A Select Case Structure is much easier for this type of thing...

Try

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [K3:K9999]) Is Nothing Then
    Select Case Target.Value
        Case "section 1" : MyColor = 15
        Case "section 2" : MyColor = 42
        Case "Structures Bay" : MyColor = 7
        Case "Section 3a","Section 3b" : MyColor = 6
        Case "section 4" : MyColor = 10
        Case Else : MyColor = xlNone
    End Select
    Range("A" & Target.Row).Resize(1,15).Interior.Colorindex = MyColor
End If
End Sub

 

[simi_uk]

thanks guys, this works great. I've changed it to use the 'CASE' argument also, so thanks for the tip JonMo1.

also, is it possible ot retrict the range that the following code uses to the same range (A thru O)?

I tried to edit it to use " Range("A" & Target.Row & ":O" & Target.Row).Interior.ColorIndex = 3 " but didn't get anything but errors when trying to compile...

If sRemark = "" Then GoTo askRemark 'returns to ask reason for cancelling if left empty
Range(searchRange.Address).EntireRow.Interior.ColorIndex = 3
Cells(searchRange.Row, "N").Select
Cells(searchRange.Row, "N").Value = sRemark
Cells(searchRange.Row, "N").ClearComments
Cells(searchRange.Row, "N").AddComment.Text Text:="Previous Value was " & PreValue & Chr(10) & "Cancelled by " & Environ("UserName") & " on " & Chr(10) & Format(Date, "dd-mm-yyyy")
Worksheets("demands").Protect Password:="JSmith"
Exit Sub 'quits when a match is found
End If

 

[Jonmo1]

change
Range(searchRange.Address).EntireRow.Interior.ColorIndex = 3
to
Range("A" & searchRange.Row).Resize(1,15).Interior.ColorIndex = 3