Simple colour dropdown

[lance.harlow]

Hi,

I would like to create a very simple colour dropdown list containing
16 colours.
This list could be either a list displaying colours - a user would
select 1.

Alternatively it would be list displaying words and once chosen the
cell would change to that colour chosen.

The following code works but I need it to work on the combo change
event - at the moment its only working on a text change.

Sub auto_open()

' Run the macro DidCellsChange any time a entry is made in a
' cell in Sheet1.
ThisWorkbook.Worksheets("Sheet1").OnEntry = "DidCellsChange"

End Sub


Sub DidCellsChange()
Dim KeyCells As String
' Define which cells should trigger the KeyCellsChanged macro.
KeyCells = "E22:E300"
'KeyCells = "D1200, C1:C10"

' If the Activecell is one of the key cells, call the
' KeyCellsChanged macro.
If Not Application.Intersect(ActiveCell, Range(KeyCells)) _
Is Nothing Then KeyCellsChanged

End Sub

Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E22:E300")
txt = Cell.Value
'http://www.mvps.org/dmcritchie/excel/colors.htm
Select Case txt
Case "Silver"
Cell.Interior.ColorIndex = 15
Case "White"
Cell.Interior.ColorIndex = 2
Case "Red"
Cell.Interior.ColorIndex = 3
Case "Pink"
Cell.Interior.ColorIndex = 38
Case "Yellow"
Cell.Interior.ColorIndex = 27
Case "Black"
Cell.Interior.ColorIndex = 1
Case "Navy"
Cell.Interior.ColorIndex = 25
Case "Blue"
Cell.Interior.ColorIndex = 5
Case "Green"
Cell.Interior.ColorIndex = 10
Case "Teal"
Cell.Interior.ColorIndex = 31
Case "Lime"
Cell.Interior.ColorIndex = 4
Case "Aqua"
Cell.Interior.ColorIndex = 28
Case "Maroon"
Cell.Interior.ColorIndex = 30
Case "Purple"
Cell.Interior.ColorIndex = 29
Case "Olive"
Cell.Interior.ColorIndex = 12
Case "Gray"
Cell.Interior.ColorIndex = 16
Case Else
Cell.Interior.ColorIndex = xlNone
End Select

Next Cell

End Sub

 

[Tom Hutchins]

Check out John Walkenbach's color picker code at www.j-walk.com

Hope this helps,

Hutch

 

[FSt1]

hi
this works in 2003 sheet combo box. i shortened the list of colors and range
for test/play purposes. i also added font colors. in the listfillrange of the
combobox i added a blank cell to take the cells back to no color if selected.
Private Sub cbo1_Change()
Dim cell As Range
Dim txt As String
For Each cell In Range("E4:E10")
txt = cbo1.Value
Select Case txt
Case "Silver"
cell.Interior.ColorIndex = 15
cell.Font.ColorIndex = 1
Case "Pink"
cell.Interior.ColorIndex = 38
cell.Font.ColorIndex = 1
Case "Yellow"
cell.Interior.ColorIndex = 27
cell.Font.ColorIndex = 1
Case "Black"
cell.Interior.ColorIndex = 1
cell.Font.ColorIndex = 2
Case "Blue"
cell.Interior.ColorIndex = 5
cell.Font.ColorIndex = 2
Case "Green"
cell.Interior.ColorIndex = 10
cell.Font.ColorIndex = 2
Case Else
cell.Interior.ColorIndex = xlNone
End Select

Next cell

End Sub

regards
FSt1

 

[FSt1]

hi
found a flaw.
if you are going to use the font color add ...
cell.font.colorindex = 1 after
cell.Interior.ColorIndex = xlNone

because if you selct a color that change the font color to white then select
no color,
the font color stays white and the text "disappears. opps.

regards
FSt1