Worksheet Function Change Row Colors According to Value

[rama4672]

I have done a service schedule in Excel, What i am trying to get it to do is when you put an "x" in a cell it will automatically change the color of the cell.
Below is the code i have written, Can someone throw some light on what i am doing wrong(probaly everything)
Thanks
Ian

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim x As Integer
Dim s As Integer
Dim m As Integer
  With Range("A1:z150")
    If Cells.Value = x Then
        Cells.Interior.ColorIndex = 34
        If Cells.Value = s Then
            Cells.Interior.ColorIndex = 32
        End If
    End If
End With
End Sub

[Zack Barresse]

hello Ian!

what are x, s, and m values? or do you mean the characters "x", "s" & "m"?

and will there be more than only those?

[rama4672]

thanks for the reply Zack
yes they are the characters, there will be probabley 5 characters altogether, ie: m will stand for mot, s for service and so on.

[Zack Barresse]

hello Ian, sorry about the delay, got busy suddenly. try this in your worksheet code...

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 26 Or Target.Row > 150 Then Exit Sub
    On Error GoTo err1
    Select Case Target.Value
        Case Is = "x"
            Target.Interior.ColorIndex = 34
        Case Is = "s"
            Target.Interior.ColorIndex = 32
        Case Is = "m"
            Target.Interior.ColorIndex = 55
        Case Is = ""
            Target.Interior.ColorIndex = 0
            err1: Exit Sub
    End Select
End Sub

substitute for your desired changes, and add as needed.

does this help?

[rama4672]

Thanks Zack

Just what i needed

Ian

[Anne Troy]

Hi, guys!!

Ian: Welcome to the board!

Is this some code we should push to the knowledgebase?
Is it something others might be able to use sometime, and can we have your permission to post it up there, Ian?

What do you think?

Please notice the new ranking icons for people with knowledgebase contributions.

[SJ McAbney]

Is there somewhere that lists what all the different colours and/or quantities mean with respect to contributions?

[rama4672]

Hi Anne

Yes i think it could be useful to others
Here is a bit of code i found that lists all the colors with their respective numbers

Sub colors56()
'57 colors, 0 to 56
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim i As Long
Dim str0 As String, str As String
For i = 0 To 56
    Cells(i + 1, 1).Interior.colorindex = I
    Cells(i + 1, 1).Value = "[Color " & i & "]"
    Cells(i + 1, 2).Font.colorindex = I
    Cells(i + 1, 2).Value = "[Color " & i & "]"
    str0 = Right("000000" & Hex(Cells(i + 1, 1).Interior.color), 6)
    'Excel shows nibbles in reverse order so make it as RGB
    str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    'generating 2 columns in the HTML table
    Cells(i + 1, 3) = "#" & str & "#" & str & ""
    Cells(i + 1, 4).Formula = "=Hex2dec(""" & Right(str0, 2) & """)"
    Cells(i + 1, 5).Formula = "=Hex2dec(""" & Mid(str0, 3, 2) & """)"
    Cells(i + 1, 6).Formula = "=Hex2dec(""" & Left(str0, 2) & """)"
    Cells(i + 1, 7) = "[Color " & i & ")"
Next i
done:
Application.Calculation = xlCalculationAutomatic 'pre XL97 xlAutomatic
Application.ScreenUpdating = True
End Sub

Regards
Ian

[Anne Troy]

Hi, Abulafia: Not yet. I need to create a page.

Ian: Thanks! Can you make a sample file with that in it?

[rama4672]

Sorry it took so long to get back to you I just got side tracked on something else, But here is my demo file showing everything is working as it should

Regards

Ian

[Anne Troy]

Not a problem, Ian!

I'm waiting for our submission form anyway, now.
No sense in building manually what can be automated, right?

[Ivan F Moala]

Hi Anne

Yes i think it could be useful to others
Here is a bit of code i found that lists all the colors with their respective numbers

Sub colors56()
'57 colors, 0 to 56
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'pre XL97 xlManual
Dim i As Long
Dim str0 As String, str As String
For i = 0 To 56
    Cells(i + 1, 1).Interior.colorindex = I
    Cells(i + 1, 1).Value = "[Color " & i & "]"
    Cells(i + 1, 2).Font.colorindex = I
    Cells(i + 1, 2).Value = "[Color " & i & "]"
    str0 = Right("000000" & Hex(Cells(i + 1, 1).Interior.color), 6)
    'Excel shows nibbles in reverse order so make it as RGB
    str = Right(str0, 2) & Mid(str0, 3, 2) & Left(str0, 2)
    'generating 2 columns in the HTML table
    Cells(i + 1, 3) = "#" & str & "#" & str & ""
    Cells(i + 1, 4).Formula = "=Hex2dec(""" & Right(str0, 2) & """)"
    Cells(i + 1, 5).Formula = "=Hex2dec(""" & Mid(str0, 3, 2) & """)"
    Cells(i + 1, 6).Formula = "=Hex2dec(""" & Left(str0, 2) & """)"
    Cells(i + 1, 7) = "[Color " & i & ")"
Next i
done:
Application.Calculation = xlCalculationAutomatic 'pre XL97 xlAutomatic
Application.ScreenUpdating = True
End Sub

Regards
Ian

Ian just a couple of things
1) that code requires the AnalysisTool pac VBA installed in order to be run.
2) There are only 56 colors your indexing starts @ 0 - 56 = 57
3) The Hex values don't look right? or rather they have doubled

here is an alternative with no ATP required.

Sub GetRGB_ColorIndex()
'// Ivan F Moala
'// http://www.xcelfiles.com
Dim k, x As Single
'// 1st Clear Old data
Range([A1:G1], [A1:G1].End(xlDown)).ClearContents
x = 1
Frmt
Application.ScreenUpdating = False
[A1] = "ColorIndex"
[B1] = "Color"
[C1] = "LongValue"
[D1] = "RED"
[E1] = "GREEN"
[F1] = "BLUE"
[G1] = "HEX"
For Each k In ActiveWorkbook.Colors
    Cells(x + 1, 1) = x 'ColorIndex
    Cells(x + 1, 2).Interior.ColorIndex = x 'Color
    Cells(x + 1, 3) = k 'Longvalue
    Cells(x + 1, 4) = Cells(x + 1, 3).Value And &HFF 'RED
    Cells(x + 1, 5) = (Cells(x + 1, 3).Value And &H100FF00) / &H100 'GREEN
    Cells(x + 1, 6) = (Cells(x + 1, 3).Value And &HFF0000) / &H10000 'BLUE
    Cells(x + 1, 7) = Hex((Cells(x + 1, 3).Value)) 'HEX
    x = x + 1
Next k
Columns("A:G").Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Sub Frmt()
With Range("A1:H58")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Columns.AutoFit
    .AutoFormat Format:=xlRangeAutoFormat3DEffects2, Number:=False, _
    Font:=False, Alignment:=False, Border:=True, Pattern:=True, Width:= _
    False
End With
With Range("D1")
    .Interior.ColorIndex = 3
    .Font.ColorIndex = 2
End With
With Range("F1")
    .Interior.ColorIndex = 5
    .Font.ColorIndex = 2
End With
Range("E1").Interior.ColorIndex = 4
Range("G1").Interior.ColorIndex = 36
Range("A1:G1").Font.Bold = True
End Sub

[rama4672]

Thanks for that ivan
Thats probably why it works on one machine which i have the tools pak installed but not on the other

Regards

Ian

[jacksonworld]

Hi, I was wondering if the following code can be altered a little so as to highlight the entire row, and not just the just the first cell in the column.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 26 Or Target.Row > 150 Then Exit Sub
On Error GoTo err1
Select Case Target.Value
    Case Is = "x"
        Target.Interior.ColorIndex = 34
    Case Is = "s"
        Target.Interior.ColorIndex = 32
    Case Is = "m"
        Target.Interior.ColorIndex = 55
    Case Is = ""
       Target.Interior.ColorIndex = 0
    err1: Exit Sub
End Select
End Sub

I was also wanted to use the 4th column as a my target column, rather than the first. Can anyone help me?

Thanks

[Bob Phillips]

Hi, I was wondering if the following code can be altered a little so as to highlight the entire row, and not just the just the first cell in the column.

I was also wanted to use the 4th column as a my target column, rather than the first. Can anyone help me?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ws_exit:
    Application.EnableEvents = False
    With Target
    If .Column = 4 Then
        Select Case .Value
            Case Is = "x"
                .EntireRow.Interior.ColorIndex = 34
            Case Is = "s"
                .EntireRow.Interior.ColorIndex = 32
            Case Is = "m"
                .EntireRow.Interior.ColorIndex = 55
            Case Is = ""
                .EntireRow.Interior.ColorIndex = 0
        End Select
    End If
    End With
ws_exit:
    Application.EnableEvents = True
End Sub

[jacksonworld]

Perfect. Thanks for your help. Much appreciated