Am I asking too much from Excel??

[marlhead]

Drop-Downs with an 'Auto-Filter'

I am looking to create a series of drop-down boxes/cells (not on the same row but in different places on the worksheet, rather like a form) that work in the same way as an 'Auto-Filter'
The idea is that if I select an item from the list of drop-down #1 then when I select from drop-down #2 it will only give me the options relevant to the chosen item from drop-down #1 (& so on).

e.g. if the table/list with all my data had 3 columns, :-
first name, surname, town

Lets say the list had a 1000 entries then there would be a good chance that the first name (John) could occur on a number of rows. So the filter would need to only show John once and then the second drop-down would need to only show those surnames that have a first name of John etc.

As this data needs to be shown on a form rather than a single row on a spreadsheet I cannot use auto-filter as it does not show me the data in the way I need it.

I have spent quite some time looking for relevant posts on this subject on the forum already but so far to no avail.

Hopefully someone can point me in the right direction

Rgds

Marlhead

 

[jindon]

Hi
assuming FirstName in col.A, LastName in Col.B with header in 1st row
the code creates dropdown in E1/F1

1) right click on the sheet tab and select [ViewCode]
2) Paste the code then close the window to get back to excel
3) Select other sheet once and get back to the sheet in question

Private dic As Object

Private Sub Worksheet_Activate()
Dim r As Object, txt As String
Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
For Each r In Range("a2", Range("a" & Rows.Count).End(xlUp))
    If Not IsEmpty(r) Then
        If Not dic.exists(r.Value) Then
            dic.Add r.Value, r.Offset(, 1).Value
        Else
            dic(r.Value) = dic(r.Value) & "," & r.Offset(, 1).Value
        End If
    End If
Next
With Range("e1")
    With .Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(dic.keys, ",")
    End With
    .Select
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    If .Address(0, 0) <> "E1" Then Exit Sub
    If .Value = Empty Then Exit Sub
    With Range("f1")
        Application.EnableEvents = False
        .Value = Empty
        Application.EnableEvents = True
        With .Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=dic(Target.Value)
        End With
        .Select
    End With
End With
End Sub

 

[marlhead]

Truly brilliant Jindon,

Really appreciate your help. Presumably I can modify the positioning of the drop dows to suit my need modifying the code where appropriate and then add further

Private Sub Worksheet_Change(ByVal Target As Range)

as appropriate if required.
I will give it a go but I have tested exactly as you have listed on your post and it works great.


Marlhead