Forum Discussion
Dropdown menu with specified colors and still free text in that colored cell
- May 09, 2021
Thank you for your email message. It turns out that I had misinterpreted your request. Unfortunately, it's not possible to do what you want using conditional formatting - if a cell doesn't meet the condition, the rule will not be applied. You need VBA code instead.
See the attached workbook. It is a macro-enabled workbook, so you will have to allow macros when you open it.
Code in the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range) Dim cel As Range Dim rng As Range If Not Intersect(Range("D2:D14"), Target) Is Nothing Then ' Loop through the modified cells in D2:D14 For Each cel In Intersect(Range("D2:D14"), Target) ' Does the value occur in the list of colors? Set rng = Range("A2:A6").Find(What:=cel.Value, LookAt:=xlWhole) If Not rng Is Nothing Then ' User selected a color from the list, so copy the color cel.Interior.Color = rng.Interior.Color Else ' User entered text manually; leave color as it is End If Next cel End If End Sub
thanks and I followed your suggestion but it does not work yet. I have copied the screens to a document to clearify. So if you want to check me please send me your email address. By the way I am living in Holland Regards
Thank you for your email message. It turns out that I had misinterpreted your request. Unfortunately, it's not possible to do what you want using conditional formatting - if a cell doesn't meet the condition, the rule will not be applied. You need VBA code instead.
See the attached workbook. It is a macro-enabled workbook, so you will have to allow macros when you open it.
Code in the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range
Dim rng As Range
If Not Intersect(Range("D2:D14"), Target) Is Nothing Then
' Loop through the modified cells in D2:D14
For Each cel In Intersect(Range("D2:D14"), Target)
' Does the value occur in the list of colors?
Set rng = Range("A2:A6").Find(What:=cel.Value, LookAt:=xlWhole)
If Not rng Is Nothing Then
' User selected a color from the list, so copy the color
cel.Interior.Color = rng.Interior.Color
Else
' User entered text manually; leave color as it is
End If
Next cel
End If
End Sub
- PefterakosJun 12, 2024Copper ContributorThank you very very much!! Have a nice summer!!
- HansVogelaarJun 11, 2024MVP
The Data Validation rule has been extended to B2:E14, and the code in the worksheet module of the attached workbook refers to this range too.
- PefterakosJun 11, 2024Copper ContributorHello,
I tried to apply your code for more colums (b, c, d, e) but i got lost.. Could you give me an assist?
Thanx in advance - Eddy_MegensMay 10, 2021Copper ContributorHello Hans,
many many thanks because this is the solution I was searching!!!!