Ever wondered how to create a set of filtering drop-down lists in Excel? Below is the logic by which you can achieve this.
This will be explain as that of a Supermarket where there are Departments, Aisles and Shelves. The filters will work by selecting the department which will filter the second list showing all the Aisles in the selected department. Choosing an Aisle will show all the Shelves in that Aisle.
The prerequisites are:
3 sets of lists comprising of an item and a reference.
|Departments||Departments & Aisles||Aisles & Shelves|
Creating the lists
Each drop down lists needs to have its content populated by means of a Data Validation List. This is achieved by selecting the cell which will be the Department drop-down list and then add Data Validation using the toolbar button, see below.
Select List validation and the cell range needed is that of the Departments column, the ‘dept’ table above.
Clicking OK will convert the cell into a drop down list which can now be selected as a drop-down list. Drag and copy down that cell to make all cells in the row inherit the validation.
Data Validation like this need only be done for the department as there will be VB code used to populate the Aisle and Shelf columns.
Creating the Aisle List
The next step after creating the Department list is to create the list of Aisles that have a reference of the selected Department. This can be achieved using VB code, in this case taken from http://goo.gl/OfNBVA posted by user ‘jindon’, shown below.
Function VLookUpMulti(ByVal strIndex As String, ByVal rng As Range, Optional ref As Integer = 1, Optional myJoin As String = " ", Optional myOrd As Boolean = True) As String ' ' jindon ' http://www.mrexcel.com/forum/showthread.php?t=344561&highlight=muvlookup ' ' =VLookUpMulti(A1, C1:D100, 2, ",", False) ' Dim a, b(), i As Long, n As Long ' a check to see if the firing cell contains anything If strIndex <> "" Then 'This code was written using standard VBA, as such, 'it works perfectly on a windows pc, but not a mac. 'So instead, a custom collection has been used. 'A little class file was used from http://goo.gl/ANZLmh, written by Patrick O'Beirne. 'Set scriptDict = CreateObject("Scripting.Dictionary") 'not used now Dim scriptDict As Collection ' custom collection Set scriptDict = New Collection a = rng.value ReDim b(1 To UBound(a, 1), 1 To 2) 'var for a tempword - this will be the selected department to begin with 'but will become the selected Aisle when an aisle has been chosen. Dim tempword As String 'this loops through all the cells that are within the range of rows for Aisles (and shelves when at 'that stage) and compares the adjacent cell to the located Department to get the Aisle name. For i = 1 To UBound(a, 1) tempword = a(i, 2) 'if the department = the aisles department (or Aisle = Shelfs aisle if at that stage) If LCase(a(i, 1)) = LCase(strIndex) Then 'add the aisle to the dictionary (or shelf if at that stage) scriptDict.Add tempword n = n + 1: b(n, 1) = a(i, 2) b(n, 2) = IIf(IsNumeric(a(i, 2)), a(i, 2), UCase(a(i, 2))) End If Next 'This takes the generated list and creates a comma separated list, which can be used to populate a 'reference cell which will be used to create the validation on the actual Aisles column VSortM b, 1, n, 2, False For i = 1 To n VLookUpMulti = VLookUpMulti & IIf(VLookUpMulti = "", "", myJoin) & b(i, 1) Next End If End Function Sub VSortM(ary, LB, UB, ref, myOrd) Dim i As Long, ii As Long, iii As Long, M, temp i = UB: ii = LB M = ary(Int((LB + UB) / 2), ref) Do While ii <= i If myOrd Then Do While ary(ii, ref) < M: ii = ii + 1: Loop Do While ary(i, ref) > M: i = i - 1: Loop Else Do While ary(ii, ref) > M: ii = ii + 1: Loop Do While ary(i, ref) < M: i = i - 1: Loop End If If ii <= i Then For iii = LBound(ary, 2) To UBound(ary, 2) temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp Next i = i - 1: ii = ii + 1 End If Loop If LB < i Then VSortM ary, LB, i, ref, myOrd If ii < UB Then VSortM ary, ii, UB, ref, myOrd End Sub
The above code takes the value selected from a list, in this case to begin with it is the Department. It then interrogates the specified range of cells and creates a collection of all common items that match the corresponding value selected from the list.
The formulae to execute the above code is:
=VLookUpMulti(A1, C1:D100, 2, ",", False)
- Where A1 is the firing cell – to begin with this is the Departments drop down list.
- C1:C100 is the range in which the firing cell’s value will be searched.
- 2 is an optional value, used for sorting, but not required in this example.
- “,” is the character to separate the list – a comma will make it a comma delimited list, although a Pipe (|) could also be used
- False is an optional value
This formula is added to an adjacent cell to the Department drop down list – denoted as 1 in the image below. The cell denoted 2 is a copy of the forumlae cell – needed to allow values in drop down lists to be cleared when a new filter search is started (i.e. a new department is selected).
Now choosing a Department from the drop down list will trigger the cell denoted by 1 (and 2 as this is a copy of 1) to contain a comma separated list of all corresponding aisles, shown below.
This needs converting into a drop down list, which again, can be achieved by some VB code.
'this subroutine is fired when the workbook detects a change, such as a drop down list has been 'changed Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range, MyColumnLetter 'The cells that will cause the functions to fire Dim Column1Letter, Column2Letter, Column3Letter 'Department column Column1Letter = "M" Set Column1 = Range("M1:M100") 'Aisle column Column2Letter = "P" Set Column2 = Range("P1:P100") 'Shelf column Column3Letter = "R" Set Column3 = Range("R1:R100") ' Get the column letter to allow the correct function call Dim whichColumnFired As String whichColumnFired = Target.Column MyColumnLetter = GetMyColumnLetter(whichColumnFired) If (MyColumnLetter = Column1Letter) Then 'if Department column just fired 'check if the current cell is empty or not If (Sheet1.Range(Target.Address).value <> Empty) Then 'is the current cell in the same range as Column1, i.e. a department If Not Application.Intersect(Column1, Range(Target.Address)) Is Nothing Then 'if so then update the Aisle column Call UpdateBColumn(Target.Address) End If End If End If 'this is the same as the above, but for the Shelves drop down list If (MyColumnLetter = Column2Letter) Then 'if Aisle column just fired If (Sheet1.Range(Target.Address).value <> Empty) Then If Not Application.Intersect(Column2, Range(Target.Address)) Is Nothing Then Call UpdateCColumn(Target.Address) End If End If End If End Sub 'Update the Aisles drop down list with correct aisles Function UpdateBColumn(Target) Dim dvList As String dvList = Target If (Sheets("Sheet1").Range(dvList).value <> "") Then Dim stringToCheck As String stringToCheck = Sheets("Sheet1").Range(dvList).Offset(0, 1) 'is this actually a new filter If stringToCheck <> "" Then 'clear the aisle and shelf cells as this is a new filter Sheets("Sheet1").Range(dvList).Offset(0, 3).ClearContents Sheets("Sheet1").Range(dvList).Offset(0, 5).ClearContents 'create the list of Aisles in the Aisle cell With Sheets("Sheet1").Range(dvList).Offset(0, 3).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=stringToCheck .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End If End If End Function 'update shelf drop down list with correct shelves Function UpdateCColumn(Target) Dim dvList As String, predvList As String 'the reference of the adjacent cell - an alternate to offset? predvListColumn = Range(Split(Target, "$")(1) & 1).Column + 1 predvListRow = Split(Target, "$")(2) MyColumnLetter = GetMyColumnLetter(predvListColumn) 'cell of where the comma separated list of shelves is currently dvList = MyColumnLetter + predvListRow Dim stringToCheck As String stringToCheck = Sheets("Sheet1").Range(dvList) 'clear the shelf cell again because the aisle shelf just fired Sheets("Sheet1").Range(dvList).Offset(0, 1).ClearContents '~~> Creates the list of shelves in the shelves cell With Sheets("Sheet1").Range(dvList).Offset(0, 1).Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=stringToCheck .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With End Function 'function to get the column code of the cell that changed Function GetMyColumnLetter(whichColumnFired) If whichColumnFired > 26 Then MyColumnLetter = Chr(Int((whichColumnFired - 1) / 26) + 64) & Chr(((whichColumnFired - 1) Mod 26) + 65) Else MyColumnLetter = Chr(whichColumnFired + 64) End If GetMyColumnLetter = MyColumnLetter End Function
The above code would need tweaking for your own excel spreadsheet, but you can see that based on which cell does the firing, the appropriated function call is made to update the Aisle cell or the Shelf cell.
You can download this in excel from the following url
The one thing to note – the validation gets knocked off when you open this excel file – it just needs re-adding by following the first step in this post.