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:


TonySallyMarthaBilly
Monday5131
Tuesday241
Wednesday221
Thursday1
Friday721
Saturday31
Sunday212

<tbody>
</tbody>

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

NAME (static dropdown list)DAY (dynamic dropdown list)RESULT

<tbody>
</tbody>

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.
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

J
  • Solved
Auto-populate cell if data validation list has only one option
Replies
7
Views
236
Jeffrey Mahoney
Jeffrey Mahoney
P
  • Question
Dynamic chart based on month
Replies
7
Views
318
skillilea
S
K
  • Question
Looking to create a drop-down list where selecting a name brings me to a specific cell containing that name
Replies
5
Views
103
SanjayGMusafir
SanjayGMusafir
S
  • Solved
Dynamic Sheet using Drop Down List & INDIRECT using External File
Replies
5
Views
367
smozgur
smozgur
I
  • Solved
Type in field to jump to first instance of what was typed from a drop down list
2 3 4
Replies
38
Views
870
ipbr21054
I

Forum statistics

Threads
1,214,979
Messages
6,122,550
Members
449,088
Latest member
davidcom

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