Multiple dependant comboboxes with repeating list

Blanchetdb

Board Regular
Joined
Jul 31, 2018
Messages
153
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I presently have a coding that works but it is extremely long and I would like to know if there is an easier way (I am presuming yes)

Present set up
ComboBox1(ListProv1) -select a Province / ComboBox2(ListCity1) -select a City
the list of cities will depend on the selection in Combobox1

this repeats up to (ListProv10)

here is the present coding:


Code:
Private Sub ListProv1_Change()
Dim index As Integer
 index = ListProv1.ListIndex
 
 ListCity1.Clear
 
Select Case index
     Case Is = 0
         With ListCity1
             .AddItem "Balzac"
             .AddItem "Brooks"
             .AddItem "Calgary"
             .AddItem "Coutts"
             .AddItem "Edmonton"
             .AddItem "Fort Macleod"
End With
     Case Is = 1
         With ListCity1
             .AddItem "Abbotsford"
             .AddItem "Agassiz"
             .AddItem "Armstrong"
             .AddItem "Burnaby"
             .AddItem "Chilliwack"
             .AddItem "Cloverdale"
             .AddItem "Coquitlam"
End With
     Case Is = 2
         With ListCity1
             .AddItem "Blumenort"
             .AddItem "Boissevain"
             .AddItem "Brandon"
             .AddItem "Carman"
             .AddItem "Dauphin"
             .AddItem "Emerson"
End With
     Case Is = 3
         With ListCity1
             .AddItem "Blacks Harbour"
             .AddItem "Clair"
             .AddItem "Edmunston"
             .AddItem "Florenceville"
             .AddItem "Fredericton"
             .AddItem "GrandFalls/Grand Sault"
             .AddItem "Moncton"
             .AddItem "Saint John"
             .AddItem "Shediac"
             .AddItem "Shippigan"
             .AddItem "St François"
             .AddItem "ST George"
             .AddItem "Woodstock"
End With
     Case Is = 4
         With ListCity1
             .AddItem "Bay Bulls"
             .AddItem "Bonavista"
             .AddItem "Brig Bay"
             .AddItem "Clarenville"
             .AddItem "Clarke's Beach"
             .AddItem "Corner Brook"
             .AddItem "Dildo"
             .AddItem "Glovertown"
End With
     Case Is = 5
         With ListCity1
             .AddItem "Antigonish"
             .AddItem "Berwick"
             .AddItem "Bible Hill"
             .AddItem "Bridgewater"
             .AddItem "Dartmouth"
             .AddItem "Digby"
             .AddItem "Halifax"
End With
     Case Is = 6
         With ListCity1
             .AddItem "Cambridge Bay"
             .AddItem "Rankin Inlet"
End With
     Case Is = 7
         With ListCity1
             .AddItem "Amherstburg"
             .AddItem "Barrie"
             .AddItem "Beamsvill"
             .AddItem "Belleville"
             .AddItem "Bradford"
             .AddItem "Bramalea"
End With         
     Case Is = 8
         With ListCity1
             .AddItem "Albany"
             .AddItem "Borden-Carleton"
             .AddItem "Charlottetown"
             .AddItem "Montague"
             .AddItem "Morell"
             .AddItem "Souris"
             .AddItem "O'Leary"
             .AddItem "Summerside"
End With    
     Case Is = 9
         With ListCity1
             .AddItem "Alma"
             .AddItem "Ange-Gardien"
             .AddItem "Anjou"
             .AddItem "Asbestos"
             .AddItem "Baie Comeau"
             .AddItem "Berthierville"
             .AddItem "Blainville"
 End With
     Case Is = 10
         With ListCity1
             .AddItem "Battleford"
             .AddItem "Carlyle"
             .AddItem "Duck Lake"
             .AddItem "Melfort"
             .AddItem "Moose Jaw"
End With
End Select
End Sub
Private Sub ListProv2_Change()
Dim index1 As Integer
 index1 = ListProv2.ListIndex
 
 ListCity2.Clear
 
Select Case index1
  Case Is = 0
         With ListCity2
             .AddItem "Balzac"
             .AddItem "Brooks"

and the whole thing restarts with the same cities ListProv10


As I said, I presently have it working but iy is very long (I also didn't list all the cities)



can you please provide some assistance?
 
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
One option would be to do it like
Code:
Dim Dic As Object

Private Sub ComboBox1_Click()
   Me.ComboBox2.Clear
   Me.ComboBox2.List = Dic(Me.ComboBox1.Value)
End Sub

Private Sub UserForm_Initialize()
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.Add "province1", Array("Balzac", "Brooks", "Calgary", "Coutts")
   Dic.Add "Province2", Array("Abbots", "Agassiz", "Burnaby")
   
   Me.ComboBox1.List = Dic.Keys
End Sub
But a simpler approach would be if you have the Provinces/cities on a sheet along the lines of


Excel 2013/2016
AB
1CountyWard
2HertfordshireSt Peters
3HertfordshireAshley
4HertfordshireHatfield Central
5HertfordshireWatling
6SomersetAbbey
7SomersetBruton
8SomersetFrome Market
9StaffordshireCastle
10StaffordshireFazeley
11WarwickshireWater Orton
12WarwickshireBidford West & Salford
13WarwickshireArden
14West MidlandsLadywood
15West MidlandsSmith's Wood
16West MidlandsNewton
17West MidlandsHalesowen North
18West MidlandsStreetly
19WorcestershireWythall West
20WorcestershireInkberrow
21WorcestershireCentral
All
 
Upvote 0

Forum statistics

Threads
1,214,813
Messages
6,121,706
Members
449,048
Latest member
81jamesacct

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