Excel 2007 : How to create drop down list but options reducing after every seclection?

Hi,

Is it possible to do a drop down list that allow user to select pre-defined selections but everytime when a selection is chosen, the list reduced?

Example,

I have can choose Apple, Orange, Durian and Mango.
The drop down can only select these 4 fruits.

So there are 4 cells in Column A1, A2, A3, A4.
A1 selects Mango and then A2 will only have 3 options to choose. So until the last cell, he can only choose the last fruit left.

A1, A2, A3, A4 are not selecting in descending order thus it could be A3 selecting first, then A2 and then A4.

I'm using excel 2007. Hope someone can enlighten me. Thanks.

Try this workbook, select from the drop-downs in Column C.
It uses the worksheet change event to determine what remains in the dropdown list.

Hope this helps.

Hi, oh yes. This is it. May I know how do you make the drop list work like this? Where do I do the change event stuff?

Hi, I managed to see the code now. I see that the pilots are pre-defined in the code. Is there a way to do it in such a way that we can add and remove the pilot's name without going into the codes? What I'm doing is that I have hundreds or thousands of items to be put into a list for selection and it changes every now and then.

Try this.

Make a dynamic named range, anywhere in your workbook, that contains all your unique values.
This list must be continuous, i.e. no blanks.
It need not be sorted, but it is better that it is.
e.g.
Formulas > Name Manager ...
Name:= "Unique_List"
Refers To:=

=OFFSET(Sheet1!$I$2,0,0,COUNTA(Sheet1!$I:$I)-1,1)

You can add to, subtract from, or amend this list as required, just don't leave any blanks.

Note
Any changes made to the list will not be reflected in Column C if their values have been entered before the changes were made.

I have amended the code to use this named range, see the attached workbook.

This will slow down considerably if you are talking of thousands of unique values.

You will no doubt need to change the Ranges in the code to suit your sheet layout.
These changes need only be made in the Sub "Worksheet_Change"

Hi,

My list actually contains computer model numbers, thus the ReducingChoiceInList.xls is rather different.

Is there a list to arrList = Array? Can I house thousands of characters example, X200, T61, T420, etc etc?

I was thinking of transposing all the information which is stored in rows like A1, A2, A3, A4 to A1, B1, C1, D1 and then adding "xx" and "," and make them into a string in one cell then copy into the arrlist. Is it possible to do that?

Did you miss post #4?

Despite what Vack says, it does work.

Here is the workbook with your data added, sorted, and duplicates removed.

Read Post #4 in conjunction with this workbook.

Unfortunatly VBa doesn't recognise dynamic names outwith the sheet it is written for
i.e. Unlike Excel, it cannot recognise where a named range is within a workbook.

We have to tell VBa what sheet it is in
Change the worksheet module code to this (Sheet "Selection")

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect As Range, rngUniqueList As Range
    Dim arrList As Variant
    Dim strList As String
    Dim LastRow As Long
    Dim i As Integer
       
    Set rngUniqueList = Sheets("System List").Range("Unique_List")
    LastRow = rngUniqueList.Rows.Count + 1
    
    Set isect = Application.Intersect(Target, Range("C2:C" & LastRow))
    If isect Is Nothing Then
        Set isect = Nothing
        Exit Sub
    End If
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    On Error GoTo ResetApplication
    
    arrList = rngUniqueList
    ' Resize Dropdown List
    For i = LBound(arrList) To UBound(arrList)
        If Not FindInDDList("C2:C" & LastRow, CStr(arrList(i, 1))) Then
            If i = LBound(arrList) Then
                strList = CStr(arrList(i, 1))
            Else
                strList = strList & "," & CStr(arrList(i, 1))
            End If
        End If
    Next
    'Apply Validation List to blank cells in range
    For i = 2 To LastRow
        If Range("C" & i) = "" Then
            ReplaceDDList Range("C" & i).Address, strList
        Else
            ReplaceDDList Range("C" & i).Address, Range("C" & i).Value
        End If
    Next
    
ResetApplication:
    Target.Select
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

I have used the information above, and it works wonderfully. I had some trouble, but it was all user-induced mental constipation.

Thank you for sharing the code... It makes my project worthwhile!

K7