Change pattern colour linked to content

[Matthew]

Not sure if someone has asked this before, if so I can not find it.

I have a sheet that needs to be formatted for printing. The text in the file is a lookup form a different sheet.

What I am trying to do is colour code thing ie if the cell is YEL and change colour to Yellow, BLU to Black and so on.

Any help would be appreciated.


1 2 3 4 5 6 7 8 9 10 11 12 13
1 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125
2 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK

3 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125
4 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125
5 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125
6 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125
7 YEL BLU NAT NAT BLU BLU BLK BLK BLU NAT NAT BLK BLK
100 0 0 0 0 0 65 0 0 0 55 140 125

 

[mikerickson]

Have you looked at Conditional Formatting?
How many different abbreviations are involved?

 

[Matthew]

Hi,

Yes have looked at conditional formatting but am looking at up to 12 different colours

Thanks

 

[mikerickson]

Code like this should work when put in the sheet's code module

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim keyRange As Range
    Dim oneCell As Range
    Set keyRange = Range("A1:B10")
    If Not Application.Intersect(keyRange, Target) Is Nothing Then
        For Each oneCell In Application.Intersect(keyRange, Target)
            With oneCell
                Select Case UCase(CStr(.Value))
                    Case "BLU"
                        .Interior.Color = vbBlue
                    Case "GRN"
                        .Interior.Color = vbGreen
                    Case "PUR"
                        .Interior.Color = RGB(255, 0, 255)
                    Case "etc"
                    
                    Case Else
                        .Interior.ColorIndex = xlNone
                End Select
            End With
        Next oneCell
    End If
End Sub

 

[Matthew]

Thanks for this.

Matthew