Excel VBA

css navigation by Css3Menu.com

Another Colorful List

I was trying to get the HEX value of a whole lot of colors for a web page. This just popped out of my fingers.
Sub ColorTotalChart()
    Dim i       As Integer
    Dim X       As Integer
    Dim RR      As Integer
    Dim C       As Integer
    Dim Skip    As Integer
    Dim Comma   As String
    Dim Tick    As String

    Tick = Chr(39)
    Comma = Chr(44)		  'Define comma
    Sheets.Add		  'Add blank worksheet
    RR = 1
    C = 350			  'Define breaking point between font colors
    Skip = 16
    For X = 0 To 255 Step 8
        For i = 1 To 16
            Cells(RR, i).Interior.Color = RGB(i * Skip, X, X)
            Cells(RR, i).Value = Tick & Application.Dec2Hex(i * Skip) & Application.Dec2Hex(X) & Application.Dec2Hex(X)
            If (X + X + (i * Skip)) < C Then
                Cells(RR, i).Font.ColorIndex = 2
            End If
        Next i
        RR = RR + 1
    Next X
    For X = 255 To 0 Step -8
        For i = 16 To 1 Step -1		  'You’ll love beauty of this
            Cells(RR, i).Interior.Color = RGB(X, i * Skip, X)
            Cells(RR, i).Value = Tick & Application.Dec2Hex(X) & Application.Dec2Hex(i * Skip) & Application.Dec2Hex(X)
            If X + X + (i * Skip) < C Then
                Cells(RR, i).Font.ColorIndex = 2
            End If
       Next i
        RR = RR + 1
    Next X
    For X = 0 To 255 Step 8
        For i = 1 To 16
            Cells(RR, i).Interior.Color = RGB(X, X, i * Skip)
           ' Cells(RR, i).Value = X & Comma & X & Comma & i * Skip
            Cells(RR, i).Value = Tick & Application.Dec2Hex(X) & Application.Dec2Hex(X) & Application.Dec2Hex(i * Skip)
            If X + X + (i * Skip) < C Then
                Cells(RR, i).Font.ColorIndex = 2
            End If
        Next i
        RR = RR + 1
    Next X
    Columns.AutoFit		  'One last pretty it up

End Sub

You’re going to like how I handled the cells that the interior color was too dark to read the value.

© 2017-2018

Updated:  11/20/2018 20:24
This page added:  14 June 2017