Dropdown menu only for conditional formatting

[BramDingemanse]

Hello Everyone,

I know it's possible to have conditional formatting with a dropdown menu. Now I want this without taking over the value of the drop down menu.
For example:
Cell A3 contains the value "Project 1".
Also cell A3 has a dropdown menu with three options: "Not stared", "In progress", "Done".

When I select "Done" from the drop down menu I want cell A3 to turn green but not change value to "Done".
The dropdown menu only changes the color of the cell, not its value.

I know I can use another cell for the drop down menu, but I would like to have it in the same cell.


Thanks in advance!

 

[BramDingemanse]

YES! Your the man eh.. kvsrinivasamurthy!! Thank you so much!

 

[mumps]

Try:

Dim val As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub
    val = Target.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo errHandler
    Select Case Target.Value
        Case "Done"
            Target.Interior.ColorIndex = 4
        Case "Not started"
            Target.Interior.ColorIndex = 3
        Case "In progress"
            Target.Interior.ColorIndex = 45
    End Select
    Target.Value = val
errHandler:
    Application.EnableEvents = True
End Sub

 

[BramDingemanse]

Hi kvsinivasamurty,

Can you help me one more time? Your code works great! Exept that I get Error code 13, mismatch. When I select multiple cells. Do you know a solution for this error?

 

[Yongle]

Exept that I get Error code 13, mismatch. When I select multiple cells. Do you know a solution for this error?

Try

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  [COLOR=#b22222]  If Target.CountLarge > 1 Then Exit Sub[/COLOR]
    If Intersect(Target, Range("A3")) Is Nothing Then Exit Sub
    val = Target.Value
End Sub

 

[kvsrinivasamurthy]

Revised code is here.

Public Str As String


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub


Application.EnableEvents = False




If Not Intersect(Target, Range("A3:A5")) Is Nothing Then




With Target.Interior




If Target = "Not started" Then
.Color = 255
ElseIf Target = "In progress" Then
.Color = 65535
ElseIf Target = "Done" Then
.Color = 5296274
End If




End With
Selection.Validation.Delete




Target.Value = Str




End If
Application.EnableEvents = True




End Sub




Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub


If Not Intersect(Target, Range("A3:A5")) Is Nothing Then
Str = Target.Value




    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="Not started,In progress,Done"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End If




End Sub
Quick reply to this message Reply    Reply With Quote Reply With Quote    Multi-Quote This Message   0  0