Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code)David miller (dlmille)
IntroHave you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Country Name) only to find that list had duplicates, wasn’t sorted, and you had to 1) build a separate list somewhere else in the spreadsheet, 2) figure out how to make the elements in that list unique, then 3) maintain that list from that moment forward?
The following is an exercise to enable simple steps in generating a drop down list of unique items, with the added value of sustaining that linkage, for the ComboBox Active-X control.
Depending on your interest, I plan to publish again in the near future to demonstrate how, with just a few changes, to apply many of these same techniques for any other list-related Active-X Control, and even the simple Data Validation List.I’ve seen many questions posted asking how to create a unique list, eliminate duplicates, etc., and there are several good approaches which I won’t go into, here (for bigger chores, I encourage you to read brettdj’s article
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_2123-Eliminating-duplicate-data-with-Duplicate-Master-V2.html.)
This article was spawned by such a question, recently. It got me thinking about a few personal techniques that I had been developing that were itching to be applied:
- Creating a “memory” for Active-X objects, that could retrieve settings or user parameters based on an event. (E.g., dynamically maintaining the unique list, even if the underlying data changes)
- Building a simple, 4-step process for anyone to incorporate this approach into their workbook
Note: The aforementioned Dictionary Class article (see citation in the first bullet, above) provides some detail on early versus late binding with respect to the Dictionary data type, if you prefer late binding, then make the appropriate modifications.
I've chosen to use early binding, which means that
when you implement this utility as "written", if you haven't already, you'll need to add the Microsoft Scripting Runtime Library to your references, in the VBA Project editor (see figure, below):
First, I’ll share the code, and the techniques I used, and then the process for implementation in your workbook.
There are two primary functions plus one subroutine in this utility, which can be added to a Public Module in your workbook:
1. Function obtainComboboxListRange() - returns the ListFillRange of an existing ComboBox
2. Function getComboBoxUnique() - returns a dictionary of items found from interrogating the ComboBox ListFillRange. By definition the dictionary will contain the unique/distinct list
3. Sub loadMyComboBoxUnique() - a routine which obtains a ComboBox’s current ListFillRange and reconfigures the ComboBox to contain the unique set of items from that ListFillRange
Function obtainComboBoxListRange(cBox As ComboBox) As Range
If cBox.ListFillRange = "" Then
'do nothing
Else
Set obtainComboBoxListRange = Range(cBox.ListFillRange)
End If
End Function
Function getComboBoxUnique(cBox As ComboBox) As Dictionary
Dim uniqueList As Dictionary
Dim myItem As Variant 'for the list currently in the ComboBox
Dim i As Integer
Set uniqueList = New Dictionary
For i = 0 To cBox.ListCount - 1 'go through the current list and add them to the dictionary (dictionary won't allow duplicates)
If Not uniqueList.Exists(cBox.List(i)) Then 'ignore duplicate "keys"
uniqueList.Add cBox.List(i), i 'item count is the key, and the value is the key as well, for easy retrieval
End If
Next i
Set getComboBoxUnique = uniqueList
End Function
Sub loadMyComboBoxUnique(cBox As ComboBox, Optional Sorted As Variant = False, Optional mLink As Variant = False)
Dim cBoxRangeTest As Range, cBoxRange As Range, cBoxLinkExists As Boolean, sBuildComboBoxName As String
Dim uniqueComboBoxList As Dictionary 'could be number or text
Dim myArray As Variant
'cBox is the ComboBox Active-X control for this operation. mLink is an optional parameter which instructs the app to sustain linkage with the
'listfill range, even though the end result will be a ComboBox with set values. The way this app sustains linkage is to create a defined
'name range built around the name of the ComboBox and containing its initialized list fill range.
'some preliminary setup. Assuming there's a requirement to maintain the link between the data and the combobox, build the range name
'based on the combobox name. Then test to see whether there's already a range that has been assigned to this combobox, setting the flag
'cBoxLinkExists.
sBuildComboBoxName = "_" & cBox.Name & "_Range"
On Error Resume Next
Set cBoxRangeTest = Range(sBuildComboBoxName)
If Err.Number <> 0 Then
cBoxLinkExists = False
Else
cBoxLinkExists = True
End If
Err.Clear
On Error GoTo 0
If Not mLink Then 'maintaining linkage is not desired, so delete references from defined names, if any, and clear the cBoxLinkExists flag
On Error Resume Next 'just in case the name never existed
Application.Names(sBuildComboBoxName).Delete
On Error GoTo 0
cBoxLinkExists = False
End If
'Start the process by getting the list fill range from the ComboBox. If it exists, then use that range. If it does NOT exist, test
'to see whether there was a linkage created via the defined name created for the ComboBox. If THAT linkage exists, then fill the listbox
'as it was originally set up. If it does NOT exist, then fall through and warn the user that a fill range must be set up to initialize the
'Combo Box.
Set cBoxRange = obtainComboBoxListRange(cBox)
'if the ComboBox has no set list fill range to work with, there is no linkage, and the ComboBox actually has data, then the ComboBox has been initialized with values that are unique already, there's nothing to do
If cBoxRange Is Nothing And Not mLink And cBox.ListRows > 0 Then Exit Sub 'nothing to do
If Not cBoxRange Is Nothing Or cBoxLinkExists Then 'either the list fill range of the ComboBox is set, or a prior link exists
'save the range for refresh linkage
If cBoxLinkExists And cBoxRange Is Nothing Then 'there is no list fill range, but the link does exist, so proceed by setting the ComboBox up as it was originally
cBox.ListFillRange = "'" & cBoxRangeTest.Parent.Name & "'!" & cBoxRangeTest.Address
ElseIf mLink Then 'if link is to be maintained, then save the range tied to the combobox reference in the defined names area
Application.Names.Add Name:="'" & ActiveSheet.Name & "'!" & sBuildComboBoxName, RefersTo:="=" & cBox.ListFillRange, Visible:=False 'hide the range name
End If
'regardless of the cases above, we now have a list range from which to work - either from the fill range, or a prior link
'first, create a unique list of elements from the ComboBox "contents", re: its list fill range, in the getComboBoxUnique function
Set uniqueComboBoxList = getComboBoxUnique(cBox) ' ok - got the unique list in the dictionary
'now clear the combobox and load it with unique values
cBox.ListFillRange = "" 'clear the Combobox
'iterate through the dictionary uniqueComboBoxList Keys to get at the elements stored there (re: the unique set of elements in the original
'list fill range
If Not Sorted Then 'load the ComboBox
For i = 0 To uniqueComboBoxList.Count - 1
cBox.AddItem uniqueComboBoxList.Keys(i)
Next i
Else 'sort first
myArray = uniqueComboBoxList.Keys
Call QSort(myArray, LBound(myArray), UBound(myArray))
For i = 0 To uniqueComboBoxList.Count - 1 'now load the ComboBox with sorted array
cBox.AddItem myArray(i)
Next i
End If
Else
MsgBox "Please Go to ComboBox: " & cBox.Name & " and set the Property called ""ListFillRange"" then run this macro"
End If
End Sub
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
Select allOpen in new window
About the code:
The driving subroutine, Sub loadMyComboBoxUnique() is called by the ComboBox’ GetFocus() event, which you setup in the appropriate Sheet Codepage, containing the ComboBox’s of interest:
Example (in your Sheet1 Codepage, where you have previously added a ComboBox to your Sheet1 worksheet):
Private Sub ComboBox1_GotFocus()
Call loadMyComboBoxUnique(ComboBox1, True, True) 'The ComboBox is loaded with unique values, sorted, with linkage maintained to the original data range - as data changes, so will the ComboBox maintain its linkage to that data
'Call loadMyComboBoxUnique(ComboBox1, False, False) 'The ComboBox is loaded with unique values, is not sorted (ala Data Validation List), leveraging the ListFillRange for the first time to initiliaze the ComboBox, and remaining static, with no linkage maintained
End Sub
1:
2:
3:
4:
Select allOpen in new window
In each sheet with ComboBox’s needing this feature, you’ll need to add this code, for each ComboBox control (e.g. one for ComboBox1, ComboBox2, …, ComboBox5, etc.)
As you may have guessed, when the initial ComboBox is created, you’ll need to specify that ComboBox’s initial ListFillRange (this informs the utility where you want this drop down list pointed). Also, from the comments in the above GotFocus() event, you can see there’s a flag for informing the utility whether this is:
- a one-off setup (e.g., the unique list is loaded into the ComboBox, with no future linkage to the original data), or
- a permanent setup (e.g., the unique list is loaded into the ComboBox, and while the listfill link is broken, a new link will be created that will be managed by this utility, going forward).
- Also, whether the resulting list is to be sorted (recall the Data Validation list does not automatically sort, so this enables the utility to mimic this result). I use a simple Qsort routine which I won’t go into, here.
- 2
Technique for saving settings
I’ve developed a technique, whereby a named range could be created which then would store settings that my utilities could subsequent use (e.g., control settings – so I could reset controls that Excel has made go awry, or, as in this example, the listFillRange address). If linkage to the original dataset is desired, a range name will be created, based on the unique name of the control.
Subsequently, when the event to update the control is triggered, it’s just a matter of building the named range, looking up that value, and applying it as if the original ListFillRange were there! The named range is a Sheet-specific Scoped name, taking the form of _ComboBox1_Range and having the range address stored in the RefersTo property of the name…
Here’s how it’s stored:
sBuildComboBoxName = "_" & cBox.Name & "_Range"
Application.Names.Add Name:="'" & ActiveSheet.Name & "'!" & sBuildComboBoxName, RefersTo:="=" & cBox.ListFillRange, Visible:=False 'hide the range name
1:
2:
Select allOpen in new window
And here’s how it’s retrieved (with error checking embedded in the code, of course):
sBuildComboBoxName = "_" & cBox.Name & "_Range"
Set cBoxRangeTest = Range(sBuildComboBoxName)
cBox.ListFillRange = "'" & cBoxRangeTest.Parent.Name & "'!" & cBoxRangeTest.Address
1:
2:
3:
Select allOpen in new window
It is important to note, that there may be better events to monitor to trigger this ComboBox refresh action. Perhaps you want the list to be refreshed only when a new database is loaded, when the sheet containing the ComboBoxes are activated, etc. Just identify that situation via code, then call the loadMyComboBoxUnique() routine with each ComboBox affected. As an add, the following Sub refreshControlsOnSheet() navigates through all ComboBoxes on a given sheet and refreshes them (based on the condition of having a valid ListFillRange or their linkage previously set):
Sub refreshControlsOnSheet(Sh As Object)
'routine enumerates all objects on the worksheet (sh), determines are ComboBoxes with stored settings, then refreshes those settings
'from storage (in the defined names arena). As this navigates through all controls, the presumption is that either listfill range has been set
'on all controls, and this routine is being called ONCE to initialize ALL ComboBoxes, or that some/all of the ComboBoxes have linkage created, so
'the goal is to refresh that linkage. If the listfill range doesn't exist and there's no stored setting, that control will be skipped.
Dim myControl As OLEObject
Dim sBuildControlName As String
Dim sControlSettings As Variant
For Each myControl In ActiveSheet.OLEObjects
If myControl.OLEType = ComboBox_OLEType Then
sBuildComboBoxName = "_" & myControl.Name & "_Range" 'builds a range name based on the control name
On Error Resume Next
Set cBoxRangeTest = Range(sBuildComboBoxName)
If Err.Number <> 0 Then
cBoxLinkExists = False
Else
cBoxLinkExists = True
End If
Err.Clear
On Error GoTo 0
If Not cBoxRangeTest Is Nothing Or cBoxLinkExists Then ' either the control is ready to initialize, or has stored settings already for use
Call loadMyComboBoxUnique(myControl.Object, True, True)
End If
End If
Next myControl
End Sub
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
Select allOpen in new window
You could run this code with a CommandButton() on that sheet, on the Sheet_Activate() event, or in some other logic that determines “now is the time to refresh”.
- 3
How to Implement in Your Workbook
Steps for implementation in your workbook:
1. Copy this module into your worksheet
2. Add a ComboBox to your worksheet (if you haven’t already), and set the properties of athat ComboBox such that the ListFillRange is pointed to your list of items that may initially include duplicates (e.g., F4:F2000)
3. Enter Design Mode for that control, then double-click on the ComboBox to enter the VBA Project debugger
4. Add the following stub, for each ComboBox of interest (be sure to test this on one, to ensure you’re comfortable how everything works):
Private Sub ComboBox1_GotFocus()
loadMyComboBoxUnique(ComboBox1,TRUE) 'TRUE - to maintain linkage to the ListFillRange, FALSE - just use the initial ListFillRange, get unique values, and load the ComboBox
End Sub
1:
2:
3:
Select allOpen in new window
This methodology should work for as many ComboBoxes you want, and each one will sustain its setting if the TRUE (maintain linkage) is set in the code module for the sheet where the ComboBox is created.
Here's the entire codeset in the Module one of the example sheet:
Const ComboBox_OLEType = 2
Function obtainComboBoxListRange(cBox As ComboBox) As Range
If cBox.ListFillRange = "" Then
'do nothing
Else
Set obtainComboBoxListRange = Range(cBox.ListFillRange)
End If
End Function
Function getComboBoxUnique(cBox As ComboBox) As Dictionary
Dim uniqueList As Dictionary
Dim myItem As Variant 'for the list currently in the ComboBox
Dim i As Integer
Set uniqueList = New Dictionary
For i = 0 To cBox.ListCount - 1 'go through the current list and add them to the dictionary (dictionary won't allow duplicates)
If Not uniqueList.Exists(cBox.List(i)) Then 'ignore duplicate "keys"
uniqueList.Add cBox.List(i), i 'item count is the key, and the value is the key as well, for easy retrieval
End If
Next i
Set getComboBoxUnique = uniqueList
End Function
Sub loadMyComboBoxUnique(cBox As ComboBox, Optional Sorted As Variant = False, Optional mLink As Variant = False)
Dim cBoxRangeTest As Range, cBoxRange As Range, cBoxLinkExists As Boolean, sBuildComboBoxName As String
Dim uniqueComboBoxList As Dictionary 'could be number or text
Dim myArray As Variant
'cBox is the ComboBox Active-X control for this operation. mLink is an optional parameter which instructs the app to sustain linkage with the
'listfill range, even though the end result will be a ComboBox with set values. The way this app sustains linkage is to create a defined
'name range built around the name of the ComboBox and containing its initialized list fill range.
'some preliminary setup. Assuming there's a requirement to maintain the link between the data and the combobox, build the range name
'based on the combobox name. Then test to see whether there's already a range that has been assigned to this combobox, setting the flag
'cBoxLinkExists.
sBuildComboBoxName = "_" & cBox.Name & "_Range"
On Error Resume Next
Set cBoxRangeTest = Range(sBuildComboBoxName)
If Err.Number <> 0 Then
cBoxLinkExists = False
Else
cBoxLinkExists = True
End If
Err.Clear
On Error GoTo 0
If Not mLink Then 'maintaining linkage is not desired, so delete references from defined names, if any, and clear the cBoxLinkExists flag
On Error Resume Next 'just in case the name never existed
Application.Names(sBuildComboBoxName).Delete
On Error GoTo 0
cBoxLinkExists = False
End If
'Start the process by getting the list fill range from the ComboBox. If it exists, then use that range. If it does NOT exist, test
'to see whether there was a linkage created via the defined name created for the ComboBox. If THAT linkage exists, then fill the listbox
'as it was originally set up. If it does NOT exist, then fall through and warn the user that a fill range must be set up to initialize the
'Combo Box.
Set cBoxRange = obtainComboBoxListRange(cBox)
'if the ComboBox has no set list fill range to work with, there is no linkage, and the ComboBox actually has data, then the ComboBox has been initialized with values that are unique already, there's nothing to do
If cBoxRange Is Nothing And Not mLink And cBox.ListRows > 0 Then Exit Sub 'nothing to do
If Not cBoxRange Is Nothing Or cBoxLinkExists Then 'either the list fill range of the ComboBox is set, or a prior link exists
'save the range for refresh linkage
If cBoxLinkExists And cBoxRange Is Nothing Then 'there is no list fill range, but the link does exist, so proceed by setting the ComboBox up as it was originally
cBox.ListFillRange = "'" & cBoxRangeTest.Parent.Name & "'!" & cBoxRangeTest.Address
ElseIf mLink Then 'if link is to be maintained, then save the range tied to the combobox reference in the defined names area
Application.Names.Add Name:="'" & ActiveSheet.Name & "'!" & sBuildComboBoxName, RefersTo:="=" & cBox.ListFillRange, Visible:=False 'hide the range name
End If
'regardless of the cases above, we now have a list range from which to work - either from the fill range, or a prior link
'first, create a unique list of elements from the ComboBox "contents", re: its list fill range, in the getComboBoxUnique function
Set uniqueComboBoxList = getComboBoxUnique(cBox) ' ok - got the unique list in the dictionary
'now clear the combobox and load it with unique values
cBox.ListFillRange = "" 'clear the Combobox
'iterate through the dictionary uniqueComboBoxList Keys to get at the elements stored there (re: the unique set of elements in the original
'list fill range
If Not Sorted Then 'load the ComboBox
For i = 0 To uniqueComboBoxList.Count - 1
cBox.AddItem uniqueComboBoxList.Keys(i)
Next i
Else 'sort first
myArray = uniqueComboBoxList.Keys
Call QSort(myArray, LBound(myArray), UBound(myArray))
For i = 0 To uniqueComboBoxList.Count - 1 'now load the ComboBox with sorted array
cBox.AddItem myArray(i)
Next i
End If
Else
MsgBox "Please Go to ComboBox: " & cBox.Name & " and set the Property called ""ListFillRange"" then run this macro"
End If
End Sub
Sub refreshControlsOnSheet(Sh As Object)
'routine enumerates all objects on the worksheet (sh), determines are ComboBoxes with stored settings, then refreshes those settings
'from storage (in the defined names arena). As this navigates through all controls, the presumption is that either listfill range has been set
'on all controls, and this routine is being called ONCE to initialize ALL ComboBoxes, or that some/all of the ComboBoxes have linkage created, so
'the goal is to refresh that linkage. If the listfill range doesn't exist and there's no stored setting, that control will be skipped.
Dim myControl As OLEObject
Dim sBuildControlName As String
Dim sControlSettings As Variant
For Each myControl In ActiveSheet.OLEObjects
If myControl.OLEType = ComboBox_OLEType Then
sBuildComboBoxName = "_" & myControl.Name & "_Range" 'builds a range name based on the control name
On Error Resume Next
Set cBoxRangeTest = Range(sBuildComboBoxName)
If Err.Number <> 0 Then
cBoxLinkExists = False
Else
cBoxLinkExists = True
End If
Err.Clear
On Error GoTo 0
If Not cBoxRangeTest Is Nothing Or cBoxLinkExists Then ' either the control is ready to initialize, or has stored settings already for use
Call loadMyComboBoxUnique(myControl.Object, True, True)
End If
End If
Next myControl
End Sub
Sub initializeControlsOnSheetbyObject()
'simple routine to initialize the three ComboBox controls on the active sheet. The presumption is that perhaps NOT ALL ComboBoxes
'would require this setup, so this is a manual step.
Call loadMyComboBoxUnique(ActiveSheet.OLEObjects("ComboBox1").Object, True, True)
Call loadMyComboBoxUnique(ActiveSheet.OLEObjects("ComboBox2").Object, True, True)
Call loadMyComboBoxUnique(ActiveSheet.OLEObjects("ComboBox3").Object, True, True)
End Sub
Sub initializeAllControlsOnSheet()
Call refreshControlsOnSheet(Sheet1)
End Sub
Sub QSort(sortArray As Variant, ByVal leftIndex As Integer, ByVal rightIndex As Integer)
Dim compValue As Variant
Dim i As Integer
Dim J As Integer
Dim tempVar As Variant
i = leftIndex
J = rightIndex
compValue = sortArray(Int((i + J) / 2))
Do
Do While (sortArray(i) < compValue And i < rightIndex)
i = i + 1
Loop
Do While (compValue < sortArray(J) And J > leftIndex)
J = J - 1
Loop
If i <= J Then
tempVar = sortArray(i)
sortArray(i) = sortArray(J)
sortArray(J) = tempVar
i = i + 1
J = J - 1
End If
Loop While i <= J
If leftIndex < J Then QSort sortArray, leftIndex, J
If i < rightIndex Then QSort sortArray, i, rightIndex
End Sub
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
Select allOpen in new window
And here's the attached workbook, complete with code and a sample worksheet with 3 ComboBoxes:
To be honest, I've included error handling for those errors I could determine. However, for more advanced use of this utility, you'll want to do more general error checking to flag any issues with your code to your attention, rather than having your users deal with abnormal program termination.
Enjoy!
David Miller (dlmille)
by: LANCE_S_P on 2011-03-26 at 15:20:59ID: 25129