Excel - VLOOKUP yielding unique values in a drop-down list

I have a spreadsheet that will be used to upload data to an Access database.  After the user inputs the new product number (col A) and product description (col B),  they will choose the "Value_Title" (col C) from a drop-down list of unique values (sorted alphabetically).  The user will then select the "Value" (col D)  from a drop-down list of unique values (sorted alphabetically) which is the possible values based on the choice in col C.

In the database there are over 100 unique possibilities in the field "Value_Title".

The ODBC connection to the db is set to automatically refresh when the workbook is opened.
Data-for-Experts-Exhange-Help-Req.xlsx
Rob_QMPricingAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
You can try this....

I created a temporarily dropdown list for the first dropdown, in column E in the second worksheet, with array formula:
{="" & INDEX($C$2:$C$101, MATCH(0, COUNTIF($E$1:E1, $C$2:$C$101), 0))}

Open in new window

This array formula was used to create a unique list.

And then I created a Name "List1" which refers to this range, so that it can be used as the Data Validation rule for "Value Title" in first worksheet.

Name
PLEASE NOTE that you can move this additional column to other worksheet if it affects your data importing via ODBC.

For Data Validation, I used formula:
=OFFSET(List1, 0, 0, COUNT(IF(List1="", "", 1)), 1)

Open in new window


Data Validation
After that, I want to refresh the dropdown list for "Value", I'm doing this via Macro instead, by tracking the change of cell's value for column C ("Value Title").

In this example I'm using object Scripting.Dictionary, hence you need to add a Reference to Microsoft Scripting Runtime.

References
And the codes are as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim c As Range
    Dim dic As Scripting.Dictionary
    Dim t As String
    
    If Target.Column = 3 And Target.Row > 1 Then
        Cells(Target.Row, Target.Column + 1) = ""
        Cells(Target.Row, Target.Column + 1).Select
        
        With Worksheets("Exist. table data via ODBC").Range("C2:D101")
            Set r = .Find(What:=Cells(Target.Row, Target.Column), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
            If Not r Is Nothing Then
                Set dic = CreateObject("Scripting.Dictionary")
                
                FirstAddress = r.Address
                Do
                    If dic.Exists(r.Offset(0, 1).Value) = False Then
                        dic.Add r.Offset(0, 1).Value, r.Offset(0, 1).Value
                    End If
                    Set r = .FindNext(r)
                Loop While Not r Is Nothing And r.Address <> FirstAddress
            End If
        End With
        Set c = Cells(Target.Row, Target.Column + 1)
        c.Validation.Delete
        For i = 0 To dic.Count - 1
            If i = 0 Then
                t = dic.items(i)
            Else
                t = t & "," & dic.items(i)
            End If
        Next
        c.Validation.Add xlValidateList, , , t
    End If
End Sub

Open in new window


and attached the sample for references.
Data-for-Experts-Exhange-Help-Req_b.xlsm
Rob_QMPricingAuthor Commented:
Hi Ryan,

 I have to admit that I don't know much about VBA and scripts, etc,.  Your proposed solution appears like it will work, but I'm evaluating to make sure it will fully work for our situation.  One question re: where new data is entered on the  first sheet - in the 3rd column for Value_Title, the drop down is not listing all of the unique items, only color.  However, when I type "Fabric" in the cell, the next column "Value" lists all of the possible fabric choices.  How do you fix this?How do you get the drop-down list option to continue for subsequent rows?  Also, the actual data source contains over 110,000 records - what would need to be changed in the Countif / Index / Match data?
Ryan ChongBusiness Systems Analyst , ex-Senior Application EngineerCommented:
where new data is entered on the  first sheet - in the 3rd column for Value_Title, the drop down is not listing all of the unique items, only color.  However, when I type "Fabric" in the cell, the next column "Value" lists all of the possible fabric choices.  How do you fix this?How do you get the drop-down list option to continue for subsequent rows?

You need to drag the formula down for 3rd column accordingly.

Also, the actual data source contains over 110,000 records - what would need to be changed in the Countif / Index / Match data?

Open in new window


1. You need to update the range of Name "List1" accordingly. for example:

='Exist. table data via ODBC'!$E$2:$E$110000

but I believe in real scenario, we won't have such a long unique list.

2. You need to update the additional column E's formula in sheet: Exist. table data via ODBC , for example:

="" & INDEX($C$2:$C$110000, MATCH(0, COUNTIF($E$1:E1, $C$2:$C$110000), 0))

In addition, for a list of 110,000 records, the formula provided to generate the unique list could be relatively slow, you may need to test this out at your end.

also found a minor bug in my previous codes, so pls use this instead for better handling.

In Sheet1's module:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim c As Range
    Dim dic As Scripting.Dictionary
    Dim t As String
    Dim FirstAddress As String
    
    If Target.Column = 3 And Target.Row > 1 Then
        Cells(Target.Row, Target.Column + 1) = ""
        Cells(Target.Row, Target.Column + 1).Select
        If Cells(Target.Row, Target.Column) = "" Then
            Set c = Cells(Target.Row, Target.Column + 1)
            c.Validation.Delete
            Exit Sub
        End If
        
        With Worksheets("Exist. table data via ODBC").Range("C2:D101")
            Set r = .Find(What:=Cells(Target.Row, Target.Column), _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
            If Not r Is Nothing Then
                Set dic = CreateObject("Scripting.Dictionary")
                
                FirstAddress = r.Address
                Do
                    If dic.Exists(r.Offset(0, 1).Value) = False Then
                        dic.Add r.Offset(0, 1).Value, r.Offset(0, 1).Value
                    End If
                    Set r = .FindNext(r)
                Loop While Not r Is Nothing And r.Address <> FirstAddress
            End If
        End With
        If FirstAddress <> "" Then
            Set c = Cells(Target.Row, Target.Column + 1)
            c.Validation.Delete
            For i = 0 To dic.Count - 1
                If i = 0 Then
                    t = dic.items(i)
                Else
                    t = t & "," & dic.items(i)
                End If
            Next
            c.Validation.Add xlValidateList, , , t
        End If
    End If
End Sub

Open in new window


In Sheet2's module:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 And Target.Row > 1 Then
        Call UpdateDataValidation
    End If
End Sub

Open in new window


In ThisWorkbook's module:
Private Sub Workbook_Open()
    Call UpdateDataValidation
End Sub

Open in new window


Created a public Module with codes:
Public Sub UpdateDataValidation()
    Application.ScreenUpdating = False
    With Worksheets("New Product Data").Range("C2").SpecialCells(xlCellTypeSameValidation).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:= _
        "=OFFSET(List1, 0, 0, COUNT(IF(List1="""", """", 1)), 1)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    Application.ScreenUpdating = True
End Sub

Open in new window

Data-for-Experts-Exhange-Help-Req_c.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Rob_QMPricingAuthor Commented:
Thank you for your solution.  Sorry the long delay.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.