Data Validation with description

[staticbob]

Hi,

I would like to set-up data validation, which I know how to do.

By problem is tho, cell entries will just be a letter, A-P. Is it possible to also link a description cell into the validation drop down, but when selected only the letter is entered ??

eg,
A = Blue
B = Red
C = Green

Cell entry would be the letter only. This would save me putting input messages on the cells, which IMHO look a tad messy.

Thanks in advance,
Bob

 

[Whisperer14]

A slight modification of my earlier offering will enable you to cover both situations and also cover future needs.

OK it is recursive by nature but you will not be able to discern the time penalty.

In the code your A column is a validation list as is your B column. The lookup elements are in G1 to H5 and I1 to J5, they could be of course anywhere.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range, R As Range, iCol As Byte
    
    On Error GoTo xit
    Set C = Target
    iCol = C.Column
    Select Case iCol
        Case 1: Set R = Range("G1:H5")
        Case 2: Set R = Range("I1:J5")
'Extra case statements can be easily added and the appropriate ranges modified
    End Select
    X = WorksheetFunction.VLookup(C, R, 2, 0)
    Target.Value = X
xit:
End Sub

ANDREW - I tried to use named ranges instead of "G1:H5") but failed, eg
Set R = Range(Colours)
any ideas why it failed - XP on XP

 

[Andrew Poulsom]

The name is a string not a variable:

Set R = Range("Colours")

 

[Whisperer14]

My 66 year old brain had just reached the same answer BUT without knowing the reason!

Strings must be in quotes!

Thank you

 

[staticbob]

OK gents,

Thanks for all the solutions. I now want this method of validation to work in 6 different columns, each with a different valdn list.

I have put the validation entries after the working area , ie rows 300+ in cols D,G,H,I,K and L !

I had used Andrews initial suggestion, which was working fine on the single column.

Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Range("D6:D300"), Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = Left(Target.Value, InStr(1, Target.Value, " ") - 1)
Application.EnableEvents = True
End Sub

 

[Whisperer14]

I am sure that Andrew will come up with an alternative but youcould also use my solution, just amend the Select Case and add 4 more.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range, R As Range, iCol As Byte
    
    On Error GoTo xit
    Set C = Target
    iCol = C.Column
    Select Case iCol
        Case 1: Set R = Range("As Appropriate")
        Case 2: Set R = Range("As Appropriate")
        Case 3: Set R = Range("As Appropriate")
        Case 4: Set R = Range("As Appropriate")
        Case 5: Set R = Range("As Appropriate")
        Case 6: Set R = Range("As Appropriate")
    End Select
    X = WorksheetFunction.VLookup(C, R, 2, 0)
    Target.Value = X
xit:
End Sub

 

[Andrew Poulsom]

Replace this line:

If Intersect(Range("D6:D300"), Target) Is Nothing Then Exit Sub

with:

If Intersect(Range("D6:D300,G6:I300,K6:L300"), Target) Is Nothing Then Exit Sub