Create a Dynamically Generated List Based on Criteria

P

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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
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
MickG said:
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
Click to expand...

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
MickG said:
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 !!!
Click to expand...

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
MickG said:
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.
Click to expand...


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
You must log in or register to reply here.

Similar threads

S
  • Solved
Dynamic pulldown of sheet names
Replies
2
Views
165
ShadowRider
S
E
  • Question Question
Mirror selections from multi-select drop down list in another cell
Replies
4
Views
401
Eccymarge
E
D
  • Question Question
Choose from List Box
Replies
5
Views
183
ddnron
D
M
  • Question Question
Formula help with counting and reference cells within multiple worksheets.
Replies
3
Views
70
myall_blues
myall_blues
I
  • Solved
Check condition of cell value before populating combobo list
Replies
2
Views
253
ipbr21054
I

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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