Thread: VBA Macro
View Single Post
 
Old 06-30-2018, 07:36 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Or...
to address the request as asked...
Code:
Sub Convert_Values_To_Colors()
    Dim rng As Range, cel As Range
    Dim celStr As String, celFontColor As Long, celFillColor As Long
    
On Error Resume Next
Set rng = Application.InputBox("With the mouse, select the range to work on.", "RANGE TO WORK WITH", Type:=8)
On Error GoTo 0
If Not rng Is Nothing Then
    For Each cel In rng
        Select Case cel.Value
            Case Is = 0
                celStr = "On-Hold"
                celFontColor = RGB(225, 225, 225)  'White
                celFillColor = RGB(0, 102, 204)    'Blue
            Case Is = 10
                celStr = "Green"
                celFontColor = RGB(225, 225, 225)  'White
                celFillColor = RGB(51, 153, 102)   'Green
            Case Is = 20
                celStr = "Amber"
                celFontColor = RGB(0, 0, 0)        'Black
                celFillColor = RGB(255, 255, 0)    'Yellow
            Case Is = 30
                celStr = "Red"
                celFontColor = RGB(225, 225, 225)  'White
                celFillColor = RGB(255, 0, 0)      'Red
        End Select
        
        With cel
            If cel.Value <> "" Then
                .Value = celStr
                .Font.Color = celFontColor
                .Interior.Color = celFillColor
            End If
        End With
    Next cel
End If
End Sub
Your picture doesn't seem to show that the cell colors are the basic red, green, yellow and blue.
Here's a little procedure that will give you the RGB color of a cell so you can adjust the RGB to match.
Code:
Sub GetRGBofCell()
    Dim R As Integer
    Dim G As Integer
    Dim B As Integer
    Dim RGB As Long

RGB = ActiveCell.Interior.Color
R = RGB And 255
G = RGB \ 256 And 255
B = RGB \ 256 ^ 2 And 255

MsgBox "RGB(" & R & ", " & G & ", " & B & ")"

End Sub

Last edited by NoSparks; 06-30-2018 at 09:22 PM.
Reply With Quote