Create a Dynamically Generated List Based on Criteria

PacSum

New Member
Joined
Jan 8, 2017
Messages
30
I've exhausted the googlez and yet to find exactly what I'm looking for.

I have two worksheets. Sheet two is a drop in report from another source. Sheet one aims to provide a simple way for a user to query data on sheet two. Below is a watered down example of what I'm looking for. This table represents how many miles each person ran on a specific day:


[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]Tony[/TD]
[TD]Sally[/TD]
[TD]Martha[/TD]
[TD]Billy[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Monday[/TD]
[TD]5[/TD]
[TD]1[/TD]
[TD]3[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Tuesday[/TD]
[TD]2[/TD]
[TD]4[/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Wednesday[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Thursday[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Friday[/TD]
[TD][/TD]
[TD]7[/TD]
[TD]2[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Saturday[/TD]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Sunday[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]1[/TD]
[TD]2[/TD]
[/TR]
</tbody>[/TABLE]

On sheet 1, I want to have 2 drop downs that in conjunction will populate a result in a third cell:

[TABLE="width: 500"]
<tbody>[TR]
[TD]NAME (static dropdown list)[/TD]
[TD]DAY (dynamic dropdown list)[/TD]
[TD]RESULT[/TD]
[/TR]
</tbody>[/TABLE]

Name will contain all 4 names at all times. Simple enough. Here's the caveat. I want the DAY drop down to be dynamically populated ONLY with days > 0.

Ex 1. Select Tony in cell A1, cell B1 contains Monday, Tuesday, Saturday. Select Monday in cell B1 and cell C1 populates with 5.
Ex 2. Select Billy in cell A1, cell B1 contains all 7 days. Select Tuesday in cell B1 and cell C1 populates with with 1.

I know I could manually create 4 lists relative to each person's name. But imagine this example amplified x100.

How would one go about creating a list from this format in this manner?
 
Last edited:

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Try this:-
Place this code in the "Thisworkbook" Module
Code:
Private Sub Workbook_Open()
Data1
End Sub

Open a Basic Module and insert the code below:-
Code:
Option Explicit
Public dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Sub[/COLOR] Data1()
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
 [COLOR="Navy"]Set[/COLOR] Rng = .Range("B1", .Cells(1, Columns.Count).End(xlToLeft))
[COLOR="Navy"]End[/COLOR] With
Txt = Join(Application.Transpose(Application.Transpose(Rng.Value)), ",")

[COLOR="Navy"]With[/COLOR] Sheets("sheet1").Range("A1").Validation
    .Parent.Range("A1:C1").ClearContents
    .Delete
    .Add Type:=xlValidateList, Formula1:=Txt
[COLOR="Navy"]End[/COLOR] With
load_data
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]


[COLOR="Navy"]Sub[/COLOR] load_data()
[COLOR="Navy"]Dim[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
Ray = Sheets("Sheet2").Cells(1).CurrentRegion
 [COLOR="Navy"]Set[/COLOR] dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            [COLOR="Navy"]If[/COLOR] Not dic.exists(Ray(1, Ac)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] dic(Ray(1, Ac)) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]For[/COLOR] R = 2 To UBound(Ray, 1)
            [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(R, Ac)) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]If[/COLOR] Not dic(Ray(1, Ac)).exists(Ray(R, 1)) [COLOR="Navy"]Then[/COLOR]
                    dic(Ray(1, Ac)).Add Ray(R, 1), Ray(R, Ac)
                [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]End[/COLOR] If
        [COLOR="Navy"]Next[/COLOR] R
   [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

In sheet1 Right click sheet Tab select "View Code", Vbwindow appears, Paste the code below into this code window
Code:
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR="Navy"]Then[/COLOR]
Range("B1:C1").ClearContents
[COLOR="Navy"]With[/COLOR] Range("B1").Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=Join(dic(Target.Value).keys, ",")
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]ElseIf[/COLOR] Target.Address(0, 0) = "B1" [COLOR="Navy"]Then[/COLOR]
    Range("C1").ClearContents
    Range("C1") = dic(Range("A1").Value).Item(Range("B1").Value)
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

With you data information in sheet2, close and save Workbook.
Reopen, in sheet1 "A1" there should be a validation list of your names
Select a name in "A1", then "B1" should now have a validation list of "Days", Select a Day and "C1" should have a value
Repeat as required.
Regards Mick
 
Last edited:
Upvote 0
Hi

Another option

Define a name to an auxiliary range that captures the days and use it in the Data Validation.
 
Upvote 0
Try this:-
Place this code in the "Thisworkbook" Module
Code:
Private Sub Workbook_Open()
Data1
End Sub

Open a Basic Module and insert the code below:-
Code:
Option Explicit
Public dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Sub[/COLOR] Data1()
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Txt [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
 [COLOR=Navy]Set[/COLOR] Rng = .Range("B1", .Cells(1, Columns.Count).End(xlToLeft))
[COLOR=Navy]End[/COLOR] With
Txt = Join(Application.Transpose(Application.Transpose(Rng.Value)), ",")

[COLOR=Navy]With[/COLOR] Sheets("sheet1").Range("A1").Validation
    .Parent.Range("A1:C1").ClearContents
    .Delete
    .Add Type:=xlValidateList, Formula1:=Txt
[COLOR=Navy]End[/COLOR] With
load_data
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]


[COLOR=Navy]Sub[/COLOR] load_data()
[COLOR=Navy]Dim[/COLOR] R [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant
Ray = Sheets("Sheet2").Cells(1).CurrentRegion
 [COLOR=Navy]Set[/COLOR] dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
   [COLOR=Navy]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            [COLOR=Navy]If[/COLOR] Not dic.exists(Ray(1, Ac)) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]Set[/COLOR] dic(Ray(1, Ac)) = CreateObject("Scripting.Dictionary")
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]For[/COLOR] R = 2 To UBound(Ray, 1)
            [COLOR=Navy]If[/COLOR] Not IsEmpty(Ray(R, Ac)) [COLOR=Navy]Then[/COLOR]
                [COLOR=Navy]If[/COLOR] Not dic(Ray(1, Ac)).exists(Ray(R, 1)) [COLOR=Navy]Then[/COLOR]
                    dic(Ray(1, Ac)).Add Ray(R, 1), Ray(R, Ac)
                [COLOR=Navy]End[/COLOR] If
           [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] R
   [COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

In sheet1 Right click sheet Tab select "View Code", Vbwindow appears, Paste the code below into this code window
Code:
Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
Application.EnableEvents = False
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
Range("B1:C1").ClearContents
[COLOR=Navy]With[/COLOR] Range("B1").Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=Join(dic(Target.Value).keys, ",")
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]ElseIf[/COLOR] Target.Address(0, 0) = "B1" [COLOR=Navy]Then[/COLOR]
    Range("C1").ClearContents
    Range("C1") = dic(Range("A1").Value).Item(Range("B1").Value)
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

With you data information in sheet2, close and save Workbook.
Reopen, in sheet1 "A1" there should be a validation list of your names
Select a name in "A1", then "B1" should now have a validation list of "Days", Select a Day and "C1" should have a value
Repeat as required.
Regards Mick

I'm not a VBA pro so my debugging skills are unfortunately limited:

OheVjep.gif
 
Upvote 0
Try :-
Code:
With Sheets("Sheet2")
 Set Rng = .Range("B7", .Cells[COLOR="#FF0000"][SIZE=4][B](7, [/B][/SIZE][/COLOR]Columns.Count).End(xlToLeft))

After correcting the code you will need to close wkbook and re-open !!!
 
Last edited:
Upvote 0
Try :-
Code:
With Sheets("Sheet2")
 Set Rng = .Range("B7", .Cells[COLOR=#FF0000][SIZE=4][B](7, [/B][/SIZE][/COLOR]Columns.Count).End(xlToLeft))

After correcting the code you will need to close wkbook and re-open !!!

Progress!

The first list populates correctly with all of the names. Now I get this error after selecting a name:

7oIWLd8.gif
 
Upvote 0
If you hold the cursor over the "Target.value" in the code when it errors, does it show a value in your data list.?

When you alter the code in any way you should closed the Book and reopen it, to reset the data in the code. This may be required.
 
Upvote 0
If you hold the cursor over the "Target.value" in the code when it errors, does it show a value in your data list.?

When you alter the code in any way you should closed the Book and reopen it, to reset the data in the code. This may be required.


Yes it does. When I hover over "Target.Value" in the debug it shows the value which I have selected from the first drop down menu.
 
Upvote 0
Howdy,

Maybe I did not understand the problem requirement ... but ...

Create dynamic range for names (automatic extension to the addition of another name), and range for weekdays.
In sheet 1 where you want to get the result you use a formula like:
= Index (range with data, match (cell with name in dropdown, .....), match (cell with weekdays in dropdown, ......))
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,265
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top