Dependent drop down list for large worksheet?

[aherzog]

I have a large worksheet with four columns (A, B, C, D) with the titles: Item #, MFG, Model, Qty. There are about a 1000 items in total, which means each of these columns has a 1000 cells each. My goal is to create a second worksheet which is blank but has the same titles. I want a drop down list for each category which are dependent on each other, though only the first three columns will be dependent on each other. For example, the first row says this: Item # (Column A) = 12 (Row 1) ; MFG (Column B) = 43 ; Model (Column C) = Air Duster.

If I choose Item # 12, then I automatically want the MFG - 43 and the Model - Air Duster to show up in their respective columns (kind of like a conditional formatting type situation). Subsequently, if I choose MFG - 43 in Column B, then I automatically want Item # 12 and Model - Air Duster to show up in that same row under their assigned columns.

Is this possible? This is a large spreadsheet with about 1000 items per column. How long would something like this take? And, if what I am looking to accomplish isn't possible, does anyone have any other solutions which may give me similar results? Thanks.

 

[MickG]

Have a look a this:-
https://app.box.com/s/ub93473i36u6eulgbz2o4vuhlzln8sxm

 

[aherzog]

I'm a bit confused by this and also had an error while using this code. Any suggestions?

 

[MickG]

What causes your confusion and what was the error ??????

 

[aherzog]

When I post the code which is suggested in the link you provided, this is how it shows up:

Multi Validation list in row 1.
Doubleclick "A1" to start Validation input, then after change value in each cell (Row1) for subsequent validation list.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Rng As Range
Dim Dn As Range
Dim Dic As Object
If Target.Address(0, 0) = "A1" Then
Set Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng: Dic(Dn.Value) = Empty: Next
With Range("A1").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Dn As Range
Dim Rng As Range
Dim Dic As Object
Dim n As Integer
If Not Intersect(Target, Range("A1:E1")) Is Nothing Then
For n = Target.Column To 4
Target.Offset(, n).Validation.Delete
Next n
Set Rng = Range(Cells(2, Target.Column), Cells(Rows.Count,
Target.Column).End(xlUp))
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = 1
For Each Dn In Rng
If Dn.Value = Target.Value Then
If Not Dic.exists(Dn.Offset(, 1).Value) Then
Dic(Dn.Offset(, 1).Value) = Empty
End If
End If
Next Dn

If Dic.Count > 0 Then
With Target.Offset(, 1).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
End With
End If
End If
End Sub

I'm also not sure what this code is trying to do. The link was written in halted English and I found it hard to understand the explanations. I just copied the code and pasted it into my excel file, and this is the message that is popping up. What is the code supposed to do?

 

[MickG]

This code below will provide 4 Validation "Drop Down Box" in columns "A to D" of sheet2.
What you need to do :-
1) In sheet 1 columns "A to D" you should have your lists of related data.
2) Copy the code below and Open sheet2.
3) Right click the sheet Tab , and select "View Code", "VB Code Window appears.
4) Paste the Code into the top of VB window, Close the vb Window.
5) Double Click cell "A1", A dropdown list should appear.
6) Select from Drop Down, Then click "B1" to see new Drop Down.
7) Repeat to "D1"
Hopefully you have now got the Drop Downs you Wanted !!!!!

Option Explicit
Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
    With Sheets("Sheet1") 
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
      [COLOR=Navy]End[/COLOR] With
        [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
            Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: Dic(Dn.Value) = Empty: [COLOR=Navy]Next[/COLOR]
[COLOR=Navy]With[/COLOR] Range("A1").Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]


Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Dn              [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Rng             [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic             [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] n               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]If[/COLOR] Not Intersect(Target, Range("A1:D1")) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
  Application.EnableEvents = False
   [COLOR=Navy]For[/COLOR] n = Target.Column To 4
        Target.Offset(, n).Validation.Delete
        Target.Offset(, n).Value = ""
   [COLOR=Navy]Next[/COLOR] n
Application.EnableEvents = True
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
[COLOR=Navy]Set[/COLOR] Rng = .Range(.Cells(2, Target.Column), .Cells(Rows.Count, Target.Column).End(xlUp))
[COLOR=Navy]End[/COLOR] With
  [COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR=Navy]If[/COLOR] Not Rng(1).Offset(, 1) = "" [COLOR=Navy]Then[/COLOR]
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
       [COLOR=Navy]If[/COLOR] Dn.Value = Target.Value [COLOR=Navy]Then[/COLOR]
         [COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Offset(, 1).Value) [COLOR=Navy]Then[/COLOR]
                 Dic(Dn.Offset(, 1).Value) = Empty
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
      [COLOR=Navy]Next[/COLOR] Dn
   
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR]
 [COLOR=Navy]With[/COLOR] Target.Offset(, 1).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[aherzog]

It's very close! The only problem is that it only works for one row (row 1) and then after that, the rest of the cells do not have drop downs - they are just plain and regular cells.

Also, is there any way to choose the first drop down, and then the other information automatically shows up in the next 3 columns without manually selecting it with the drop downs, or am I limited to having to choose the drop down menus? Regardless, even if I can't, this is still very helpful!

 

[MickG]

I'm not sure what your first paragraph means,i.e how many validation list do you want and what do you want in them ???

The code below relates to your second paragraph, and enables you to have lists instead of Drop Downs.
To Install:-
Copy 7 paste the code in new sheet as before (still with the basic data in sheet1).
Double click "A1"(as before) to install first list in column "A". Then select value in list by RIGHT Clicking that value to create new list in subsequent columns.

Option Explicit
Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=Navy]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
      [COLOR=Navy]End[/COLOR] With
        [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
            Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: Dic(Dn.Value) = Empty: [COLOR=Navy]Next[/COLOR]
Range("A2").Resize(Rows.Count - 1, 4).ClearContents
Range("A2").Resize(Dic.Count).Value = Application.Transpose(Dic.keys)
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]


Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeRightClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
[COLOR=Navy]Dim[/COLOR] Dn              [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Rng             [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic             [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] n               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]If[/COLOR] Not Intersect(Target, Range("A:D")) [COLOR=Navy]Is[/COLOR] Nothing [COLOR=Navy]Then[/COLOR]
  Cancel = True
  Application.EnableEvents = False
   [COLOR=Navy]For[/COLOR] n = Target.Column To 4
        Target.Columns.Offset(, n).Value = ""
   [COLOR=Navy]Next[/COLOR] n
Application.EnableEvents = True
[COLOR=Navy]With[/COLOR] Sheets("Sheet1")
[COLOR=Navy]Set[/COLOR] Rng = .Range(.Cells(2, Target.Column), .Cells(Rows.Count, Target.Column).End(xlUp))
[COLOR=Navy]End[/COLOR] With
  [COLOR=Navy]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR=Navy]If[/COLOR] Not Rng(1).Offset(, 1) = "" [COLOR=Navy]Then[/COLOR]
   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
       [COLOR=Navy]If[/COLOR] Dn.Value = Target.Value [COLOR=Navy]Then[/COLOR]
         [COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Offset(, 1).Value) [COLOR=Navy]Then[/COLOR]
                 Dic(Dn.Offset(, 1).Value) = Empty
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
      [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR]
Cells(2, Target.Column + 1).Resize(Rows.Count - 1, 4 - Target.Column).ClearContents
Cells(2, Target.Column + 1).Resize(Dic.Count).Value = Application.Transpose(Dic.keys)
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[aherzog]

The second code did not seem to work. What I was mentioning about the first code is that is only works for one row. I want to make a list of the items I need to order, and the first code only gives me the option to choose one row's worth of dependent lists. For example, the code works when I choose the first drop down choice (A2), the second dependent list based on A2 which only has one choice (B2), and so on for the other columns in row 2. Now, I go to row 3 to start the process over for a new item and the choice for the first drop down in cell A3 is gone, and it is just a regular cell.

Is there any way for me to post a link to my workbook file so you all can take a look?

 

[MickG]

Try "Box.com" (Free File sharing)