VBA dynamic drop down list problem

F

Freeb0

New Member
Joined
Sep 12, 2014
Messages
7
Hello,

I have Excel 2010.
I am quite experienced in all excel formulas, but I have no experience in VBA. (I had C language in school, don't know if it helps)
Now i have a task that will have to be programmed in VBA probably.
I have a list of children in 1 worksheet of my excel file.
I would like to have a drop down list in another worksheet, that gives me all the children.
Every time I select a child, excel has to store this childs name somewhere, and the list has to change to show all the remaining children. so if it gave 20 children the first time, it has to show 19 children the second time, then 18 and so on.

I don't know if you guys understand my question, but please feel free to ask.

Thanks a lot !

David
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
I created an example of how I would accomplish this task.

I have two sheets in a workbook. Sheet1 and Sheet2. Sheet1 is the list of names and sheet2 is the drop down list.

Sheet1 lists names from A2 to A10, 9 total names. Cell A1 is a header "Names" as seen below.
Names
Alan
Timmy
Bill
Sheila
Terry
Pat
Walt
Walt Jr
Fred

<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>
</tbody>

Cell E1 of sheet1 is this formula =Counta(A:A)-1 and the result is 9, there are 9 names in the list.

Create a dynamic drop down list on sheet2 in cell C3. I use the name manager and use this offset formula:
=OFFSET(Sheet1!$A$2,0,0,Sheet1!$E$1,1) calling it lst_names. Then use the list data validation using lst_names.

Then the VBA. Paste this code into the sheet2 VBA editor (ALT+F11)

Sub worksheet_change(ByVal target As Range)

Dim name_selected As String
name_selected = Range("C3").Value
Dim i As Integer
Dim ii As Integer
Application.EnableEvents = False
Application.ScreenUpdating = False

i = 3
ii = 1


Do Until Range("F" & i).Value = ""
If Range("F" & i).Value = "" Then
Else
i = i + 1
End If
Loop
Range("C3").Copy
Range("F" & i).PasteSpecial xlValues

Sheets("sheet1").Activate


Do Until ii = 11
If ActiveSheet.Range("A" & ii).Value = name_selected Then
ActiveSheet.Range("A" & ii).Delete xlShiftUp
Else
ii = ii + 1
End If
Loop


Sheets("sheet2").Activate
Range("C3").Select


Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub

It will allow you to select a name from the list, paste that name into a new list made in column F and remove the name from sheet1's list. The dynamic drop down should then show only the names remaining. I know it sounds like a lot and I'd like to just send you my copy of the workbook I mocked up, just not sure how to best go about that. Let us know how it goes and good luck!
 
Upvote 0
Thank you so much for the quick help !
I wouldn't have found that without your help.
I will try to test your code as fast as possible, and I wil let you know how it went.

Thanks again man.

Awesome !



Just 1 question, do I have to paste the name manually ? Because it is about 40 students in total :).

It will allow you to select a name from the list, paste that name into a new list made in column F and remove the name from sheet1's list. The dynamic drop down should then show only the names remaining. I know it sounds like a lot and I'd like to just send you my copy of the workbook I mocked up, just not sure how to best go about that. Let us know how it goes and good luck!
 
Upvote 0
Once the names are pasted into sheet1 A2:A40 or A40000 the rest should be automatic. Just make sure the counta formula in sheet1 E1 is counting all thenames in your list.
 
Upvote 0
Try the following:-
Your Children's names in sheet1 column "A".
The validation list will be in sheet2 "A1" when you first run the code.
Place all the code below into the Worksheet module of sheet 2.
To place code:-
Right click sheet "Tab" , select ViewCode", Vbwindow appears , Paste entire code into this window
Close vbwindow.
To Fill Validation list code:-
Doubleclick in cell sheet2 "A1"
Validation list should appear with your Names in it in "A1".
Select name from validation list, The selection should show in column "D".
continue with selection until all names are in column "D".
To reset Validation list. Double click again in cell "A1 sheet2.

Code: 
Option Explicit
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rng1 [COLOR=Navy]As[/COLOR] Range
Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
 Application.EnableEvents = False
 [COLOR=Navy]With[/COLOR] Sheets("Sheet1")
        [COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With
 [COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
 Target = ""
 [COLOR=Navy]With[/COLOR] Range("A1").Validation
       .Delete
       .Add Type:=xlValidateList, Formula1:=Join(Application.Transpose(Rng1.Value), ",")
    [COLOR=Navy]End[/COLOR] With
Columns("D:D").ClearContents
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
Application.EnableEvents = False
[COLOR=Navy]If[/COLOR] Target.Count = 1 [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" And Not Target = "" [COLOR=Navy]Then[/COLOR]
Call AddVal(Target)
    [COLOR=Navy]With[/COLOR] Range("A1").Validation
      .Delete
        [COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] .Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
    [COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]
Sub[/COLOR] AddVal(Tar [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Dn              [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng2            [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Sht             [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Nums            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]


[COLOR=Navy]If[/COLOR] Tar.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]With[/COLOR] Sheets("Sheet1")
        [COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With
    [COLOR=Navy]With[/COLOR] Sheets("Sheet2")
        [COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
            Nums = IIf(Rng2.Count = 1 And Rng2(1) = "", 1, Rng2.Count + 1)
                [COLOR=Navy]If[/COLOR] Nums = 2 [COLOR=Navy]Then[/COLOR]
                    [COLOR=Navy]If[/COLOR] Tar = .Range("D" & Nums - 1) [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
                [COLOR=Navy]End[/COLOR] If
                    [COLOR=Navy]If[/COLOR] Nums <= Rng1.Count [COLOR=Navy]Then[/COLOR] .Range("D" & Nums) = Tar
                        [COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With


[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sht = Array(Rng1, Rng2)
    [COLOR=Navy]For[/COLOR] n = 0 To 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Sht(n)
           [COLOR=Navy]If[/COLOR] Not Dn.Value = vbNullString [COLOR=Navy]Then[/COLOR]
           [COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                Dic.Add Dn.Value, Nothing
            [COLOR=Navy]Else[/COLOR]
                Dic.Remove (Dn.Value)
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] Dn
    [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try the following:-
Your Children's names in sheet1 column "A".
The validation list will be in sheet2 "A1" when you first run the code.
Place all the code below into the Worksheet module of sheet 2.
To place code:-
Right click sheet "Tab" , select ViewCode", Vbwindow appears , Paste entire code into this window
Close vbwindow.
To Fill Validation list code:-
Doubleclick in cell sheet2 "A1"
Validation list should appear with your Names in it in "A1".
Select name from validation list, The selection should show in column "D".
continue with selection until all names are in column "D".
To reset Validation list. Double click again in cell "A1 sheet2.

Code: 
Option Explicit
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rng1 [COLOR=Navy]As[/COLOR] Range
Private [COLOR=Navy]Sub[/COLOR] Worksheet_BeforeDoubleClick(ByVal Target [COLOR=Navy]As[/COLOR] Range, Cancel [COLOR=Navy]As[/COLOR] Boolean)
 Application.EnableEvents = False
 [COLOR=Navy]With[/COLOR] Sheets("Sheet1")
        [COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With
 [COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
 Target = ""
 [COLOR=Navy]With[/COLOR] Range("A1").Validation
       .Delete
       .Add Type:=xlValidateList, Formula1:=Join(Application.Transpose(Rng1.Value), ",")
    [COLOR=Navy]End[/COLOR] With
Columns("D:D").ClearContents
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Private [COLOR=Navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=Navy]As[/COLOR] Range)
Application.EnableEvents = False
[COLOR=Navy]If[/COLOR] Target.Count = 1 [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]If[/COLOR] Target.Address(0, 0) = "A1" And Not Target = "" [COLOR=Navy]Then[/COLOR]
Call AddVal(Target)
    [COLOR=Navy]With[/COLOR] Range("A1").Validation
      .Delete
        [COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] .Add Type:=xlValidateList, Formula1:=Join(Dic.keys, ",")
    [COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
Application.EnableEvents = True
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]
Sub[/COLOR] AddVal(Tar [COLOR=Navy]As[/COLOR] Range)
[COLOR=Navy]Dim[/COLOR] Dn              [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n               [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Rng2            [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Sht             [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Nums            [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]


[COLOR=Navy]If[/COLOR] Tar.Address(0, 0) = "A1" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]With[/COLOR] Sheets("Sheet1")
        [COLOR=Navy]Set[/COLOR] Rng1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With
    [COLOR=Navy]With[/COLOR] Sheets("Sheet2")
        [COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
            Nums = IIf(Rng2.Count = 1 And Rng2(1) = "", 1, Rng2.Count + 1)
                [COLOR=Navy]If[/COLOR] Nums = 2 [COLOR=Navy]Then[/COLOR]
                    [COLOR=Navy]If[/COLOR] Tar = .Range("D" & Nums - 1) [COLOR=Navy]Then[/COLOR] [COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
                [COLOR=Navy]End[/COLOR] If
                    [COLOR=Navy]If[/COLOR] Nums <= Rng1.Count [COLOR=Navy]Then[/COLOR] .Range("D" & Nums) = Tar
                        [COLOR=Navy]Set[/COLOR] Rng2 = .Range(.Range("D1"), .Range("D" & Rows.Count).End(xlUp))
    [COLOR=Navy]End[/COLOR] With


[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sht = Array(Rng1, Rng2)
    [COLOR=Navy]For[/COLOR] n = 0 To 1
        [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Sht(n)
           [COLOR=Navy]If[/COLOR] Not Dn.Value = vbNullString [COLOR=Navy]Then[/COLOR]
           [COLOR=Navy]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
                Dic.Add Dn.Value, Nothing
            [COLOR=Navy]Else[/COLOR]
                Dic.Remove (Dn.Value)
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] Dn
    [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...


I finally had some time to try out the suggested solutions.

The one from madaknarf didn't work unfortunately, but your solution did work mick !
I need something like that, but a little different.

I discussed the problem with my mother (for whom I am making the excel), and the problem is the following :
Sometimes there are school excursions.
She wants to enter the price of the excursion, and then select the names out of the drop down list, for which she has a names list in another excel sheet, where for each child this cost has to be deducted from the amount of money they have on their "personal account" next to their name. And after that the drop down list has to have all the children except the ones that were already selected for that excursion.
This has to be ofcourse possible for other excursions and for other months, without writing another macro if you understand what I mean. And without taking too much space, because it still has to be possible to generate a list of all the excursion each child has done with a price overview to show the parents. :)

I know I am asking a lot, but if you could help me another time I would be very happy.

Maybe if you could send an example to my e-mailadress that would be more easy ? declercqd@gmail.com

Thanks !

Regards,

David
 
Upvote 0
Alter the code where shown in Bold.
Place the Childrens Budgets in sheet 1 column "B", against teir names.
In "C2 of sheet 2 place the cost of the "Excursion".
As you select the "Chidren" their Budgets" will be reduced by the "Excursion" amount.
Rich (BB code): 
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sht = Array(Rng1, Rng2)
    For n = 0 To 1
        For Each Dn In Sht(n)
           If Not Dn.Value = vbNullString Then
           If Not Dic.exists(Dn.Value) Then
                Dic.Add Dn.Value, Dn
           Else
                 If Dn.Value = Tar.Value Then
                    Dic.Item(Dn.Value).Offset(, 1).Value = Dic.Item(Dn.Value).Offset(, 1).Value - Sheets("Sheet2").Range("C2").Value
                End If
               
                Dic.Remove (Dn.Value)
            End If
        End If
        Next Dn
    Next n
End If
Regrds Mick
 
Upvote 0
MickG said:
Alter the code where shown in Bold.
Place the Childrens Budgets in sheet 1 column "B", against teir names.
In "C2 of sheet 2 place the cost of the "Excursion".
As you select the "Chidren" their Budgets" will be reduced by the "Excursion" amount.
Rich (BB code): 
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Sht = Array(Rng1, Rng2)
    For n = 0 To 1
        For Each Dn In Sht(n)
           If Not Dn.Value = vbNullString Then
           If Not Dic.exists(Dn.Value) Then
                Dic.Add Dn.Value, Dn
           Else
                 If Dn.Value = Tar.Value Then
                    Dic.Item(Dn.Value).Offset(, 1).Value = Dic.Item(Dn.Value).Offset(, 1).Value - Sheets("Sheet2").Range("C2").Value
                End If
               
                Dic.Remove (Dn.Value)
            End If
        End If
        Next Dn
    Next n
End If
Regrds Mick
Click to expand...


Thanks man your help is much appreciated !
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Question about Drop down list
Replies
3
Views
205
RoryA
RoryA
A
  • Question
Dependent Drop Down list
Replies
3
Views
159
Kerryx
K
R
  • Question
VBA Loop Through Data Validation Drop Down List
Replies
5
Views
310
rlv01
R
R
  • Solved
adapt drop down list after selection is made
Replies
7
Views
178
Peter_SSs
Peter_SSs
M
  • Question
VBA vs Formulas/Data Validation for Multiple Dependent Dropdown Lists
Replies
3
Views
434
MissDB101
M

Forum statistics

Threads
1,214,653
Messages
6,120,751
Members
448,989
Latest member
mariah3

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