Excel Data Validation–Create Dynamic Dependent Lists (VBA)


EDIT

I have stopped updating this blog. This link can also be found in my Website.

http://www.siddharthrout.com/2011/07/29/excel-data-validationcreate-dynamic-dependent-lists-vba/

There are times when you need to create dependent lists from a dynamic range. The data for the list can come from, say an SQL Database or even a website.

Lets say we came across a list on a website which is similar to this.

Country City
India Mumbai
Pakistan Karachi
Bangladesh Dhaka
India Delhi
India Chennai
Pakistan Lahore
Bangladesh Munshiganj
Pakistan Islamabad
Pakistan Peshawar
India Kolkata
Bangladesh Chandpur
India Lucknow
India Srinagar
Pakistan Abottabad

Now we want to create two data validation list, where the first list shows the name of the Country and the second shows the names of the Cities. Also what we would like is that if I select “India” from the first list then the second list should automatically display the cities from India only. So how do we achieve this?

The below code will help you create dependent lists just by simply pasting data in the Source Columns. For the sake of simplicity we will copy and paste the above list in Column A and Column B of an Excel Sheet, say “Sheet1”. However before we do that, we have to paste the below code in the Sheet Code Area. The sheet code area can be accessed by pressing Alt+F11 from the main worksheet. If you want to access the Visual Basic Editor from the menu then do this.

Excel 2003 : Click on the Tools menu and then click on Macros

2003

Excel 2007 : Click on the Developer Tab and then click on the “Visual Basic” as shown in the picture below

Developer Tab 2007

Excel 2010 : Click on the Developer Tab and then click on the “Visual Basic” as shown in the picture below

Developer Tab 2010

Excel 2011 (MAC) : Click on the Developer Tab and then click on the “Visual Basic” as shown in the picture below

MAC 2011

Once you have accessed the Visual basic Editor, the screen will look like this (This screen is from 2007. The other versions will have a similar screen).

VBE

Double click on the Excel object Sheet1 (Sheet1). The moment you double click, the code area on the right hand side will open up for you. Simply paste the code there and you are ready Smile

VBE-Sheet Area

The Code:

I have commented the code so that it is easier to understand.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, LastRow As Long, n As Long
    Dim MyCol As Collection
    Dim SearchString As String, TempList As String

    Application.EnableEvents = False

    On Error GoTo Whoa

    '~~> Find LastRow in Col A
    LastRow = Range("A" & Rows.Count).End(xlUp).Row

    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Set MyCol = New Collection

        '~~> Get the data from Col A into a collection
        For i = 1 To LastRow
            If Len(Trim(Range("A" & i).Value)) <> 0 Then
                On Error Resume Next
                MyCol.Add CStr(Range("A" & i).Value), CStr(Range("A" & i).Value)
                On Error GoTo 0
            End If
        Next i

        '~~> Create a list for the DV List
        For n = 1 To MyCol.Count
            TempList = TempList & "," & MyCol(n)
        Next

        TempList = Mid(TempList, 2)

        Range("D1").ClearContents: Range("D1").Validation.Delete

        '~~> Create the DV List
        If Len(Trim(TempList)) <> 0 Then
            With Range("D1").Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    '~~> Capturing change in cell D1
    ElseIf Not Intersect(Target, Range("D1")) Is Nothing Then
        SearchString = Range("D1").Value

        TempList = FindRange(Range("A1:A" & LastRow), SearchString)

        Range("E1").ClearContents: Range("E1").Validation.Delete

        If Len(Trim(TempList)) <> 0 Then
            '~~> Create the DV List
            With Range("E1").Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:=TempList
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With
        End If
    End If

LetsContinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function required to find the list from Col B
Function FindRange(FirstRange As Range, StrSearch As String) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Dim strTemp As String

    Set aCell = FirstRange.Find(what:=StrSearch, LookIn:=xlValues, _
    lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    ExitLoop = False

    If Not aCell Is Nothing Then
        Set bCell = aCell
        strTemp = strTemp & "," & aCell.Offset(, 1).Value
        Do While ExitLoop = False
            Set aCell = FirstRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                strTemp = strTemp & "," & aCell.Offset(, 1).Value
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = Mid(strTemp, 2)
    End If
End Function

Once the code is pasted, you can directly paste the list in Column A and Column B and the Data Validation List will be created in D1. Now when you select an option in D1, the Dependent Data Validation List will automatically be created in cell E1.

Attached is a video which shows the entire process. In the video, If you notice, I changed one of the city and it reflected in the Data Validation List.

Dynamic Dependent Lists

The above code can be amended to create more than 1 Dependent Data Validation List. You can also amend it so that the Column A and Column B List can be copied to a different Worksheet and you can base your Data Validation Lists on them. This is useful, if you do not want the user to see your list.

Advertisements

2 responses to “Excel Data Validation–Create Dynamic Dependent Lists (VBA)

  1. Jeff Weir November 11, 2011 at 3:35 am

    This code is both very handy as well as great VBA lesson rolled into one. Thanks for the post. Question: Do you think your code would be easily amended to accept a crosstab as the validation list inputs? In your example this would be a table with countries running across the top of the table, and the cities for each country running down the column under the particular country. This makes it easier to eyeball the data validation lists to make sure you have the data you want, and to make changes. It also allows you to have dependent lists sorted alphabetically.

    Chip Pearson has some code at http://www.cpearson.com/excel/excelM.htm that does this, but the code is a lot more complex than yours.

    I’ve amended Chip’s code for a procurement form I put together (downloadable from https://docs.google.com/open?id=0B1hgC5lSuLjVZmFmNzczZTMtYzNlZi00ZGYzLWE4NTgtODEyNDdmMWQzYjhi if anyone is interested) that needs users to select an asset class and the relevant asset category under that class. There’s one master asset class/category list, but there are multiple independent dropdowns running off this, because the form lets them order more than one asset.

    To keep the dropdowns independent, I use a Worksheet_Calculate() sub to pass the address of the active cell so I can check if it has a Named Range that denotes it as one of the master dropdowns: in this case it will have a name like Asset_Class_Input_x where x is a unique identifier. So if the active cell was Asset_Class_Input_5 itthen knows that the particular slave list to update is inputAssetCategory_5.

    For what it’s worth, my code is below. This was my first non-trivial VBA routine, so there’s no doubt room for improvement, and I’ll be looking closer at your method to see if I can amend it to my crosstab validation list.

    Option Explicit
    Public Const kList1Hnd As String = "List1Values"
    Public Const kList2Hnd As String = "List2_"
    
    
    '==========================
    'Contents of this module
    '==========================
    
    'This module contains code that maintains dependent validation lists, and
    'applies input validation settings stored in the SettingsTable worksheet.
    
    
    '--------------------------------
        ' Sub UpdateValidationLists
            ' This sub determines which validation range should be applied to a
            ' dependant (slave) dropdown, and then instructs the fzCreateValidationList2
            ' sub to load that list.
            ' It is triggered by a change to the master dropdown list via the
            ' DropdownChange sub in the Sheet1 worksheet module (which is in turn triggered
            ' by a Worksheet_Calculate() event in Sheet 1 as there is no native DropdownChange event)
            
        ' Sub pzLoadList2Lists
            ' This sub creates named ranges for the master list and for all dependant (slave) lists
            
        ' Function fzCreateValidationList1
            ' This function loads the master validation list to the specified target range.
            
        ' Function fzCreateValidationList2
            ' This function loads the dependand (slave) validation list to the specified target range.
            
        
        ' Sub MasterDropdownChange(ByVal Target As Range)
            ' This bit of code is triggered by the Worksheet_Calculate() sub in Sheet1
            ' and checks if the active cell is one of the asset class dropdowns.
            ' If so, it updates the validation applied to the relevent slave dropdown
    
        '---------------------------------------------------------------------
    Public Sub UpdateValidationLists(rngMasterList As Range, _
    rngSlaveList As Range, Optional bUpdateMasterList As Boolean)
    '--------------------------------------------------------------------
    ' This sub determines which validation range should be applied to a
    ' dependant (slave) dropdown, and then instructs the fzCreateValidationList2
    ' sub to load that list.
    ' It is triggered by a change to the master dropdown list via the
    ' DropdownChange sub in the Sheet1 worksheet module (which is in turn triggered
    ' by a Worksheet_Calculate() event in Sheet 1 as there is no native DropdownChange event)
    
    Dim oFoundCell As Range
    Dim iTargetCol As Long
    
    If rngMasterList.Count = 1 Then
        With Sheet5.Range(kList1Hnd)
            Set oFoundCell = .Find(what:=rngMasterList.Value, LookIn:=xlValues)
                If oFoundCell Is Nothing Then
                   MsgBox "Critical error"
                    Exit Sub
                End If
        End With
                
        'load the List2 dropdown and set the default to item 1
        iTargetCol = oFoundCell.Column - 1
        fzCreateValidationList2 rngSlaveList, iTargetCol, rngMasterList
        rngSlaveList.Value = Sheet5.Range(kList2Hnd & iTargetCol).Value
        If bUpdateMasterList = True Then fzCreateValidationList1 rngMasterList
    End If
    End Sub
      
            
    '---------------------------------------------------------------------
    Public Sub pzLoadList2Lists()
    '---------------------------------------------------------------------
    ' This sub creates named ranges for the master list and for all dependant (slave) lists
    
    Dim oWsData As Worksheet
    Dim cRows As Long, cCols As Long, i As Long, j As Long
    
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        On Error GoTo load_exit
        
        Set oWsData = Sheet5
        With oWsData
            'create dynamic range names for List1 and List2 lists
            cCols = .Cells(2, Columns.Count).End(xlToLeft).Column
            For i = 2 To cCols
                cRows = .Cells(Rows.Count, i).End(xlUp).Row
                ThisWorkbook.Names.Add Name:=kList2Hnd & i - 1, _
                                       RefersToR1C1:="='" & Sheet5.Name & "'!R2C" & i & ":R" & cRows & "C" & i
            Next i
        End With
        ThisWorkbook.Names.Add Name:=kList1Hnd, _
                               RefersToR1C1:="='" & Sheet5.Name & "'!R1C2:R1C" & cCols
        
    load_exit:
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        
    End Sub
    
    '---------------------------------------------------------------------
    Public Function fzCreateValidationList1(Target As Range)
    '---------------------------------------------------------------------
    ' This function loads the master validation list to the specified target range.
    
        Sheet1.Unprotect
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, _
                 AlertStyle:=xlValidAlertWarning, _
                 Formula1:="=" & kList1Hnd
            .InCellDropdown = True
            .InputTitle = [valAssetClassTitle].Text
            .ErrorTitle = ""
            .InputMessage = [valAssetClassMessage].Text
            .ErrorMessage = "This is not a valid Value"
        End With
        Sheet1.Protect Contents:=True, userinterfaceonly:=True
    End Function
    
    '---------------------------------------------------------------------
    Public Function fzCreateValidationList2(Target As Range, _
                                            idx As Long, _
                                            source As Range)
    '---------------------------------------------------------------------
    
    ' This function loads the dependand (slave) validation list to the specified target range.
        
        Sheet1.Unprotect
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, _
                 AlertStyle:=xlValidAlertWarning, _
                 Formula1:="=" & kList2Hnd & idx
            .InCellDropdown = True
            .InputTitle = [valAssetCategoryTitle].Text
            .ErrorTitle = ""
            .InputMessage = [valAssetCategoryMessage].Text
            .ErrorMessage = "This is not a valid Value for " & source.Value
        End With
         
         Sheet1.Protect Contents:=True, userinterfaceonly:=True
       
        
    End Function
    
    '---------------------------------------------------------------------
    Sub MasterDropdownChange(ByVal Target As Range)
    '---------------------------------------------------------------------
    
    ' This bit of code is triggered by the Worksheet_Calculate() sub in Sheet1,
    ' which passes the address of the active cell to this sub so we can,
    ' check if the associated Named Range (if any) is one of the
    ' asset class dropdowns (i.e.  it will have a name like Asset_Class_Input_x).
    ' If so, it updates the validation applied to the relevent slave dropdown
    ' Code adapted from http://www.cpearson.com/excel/excelM.htm
    
        Dim rngMasterList As Range
        Dim rngSlaveList As Range
        Dim N As Name
        Dim rngC As Range
        Dim sMasterDropdownTag As String
        Dim sSlaveDropdownTag As String
        Dim rngTestRng As Range
        Dim sActiveCellName As String
        On Error Resume Next
    
        sMasterDropdownTag = "inputAssetClass_"
        sSlaveDropdownTag = "inputAssetCategory_"
    
    
        For Each N In ActiveWorkbook.Names
            Set rngC = Nothing
            Set rngTestRng = N.RefersToRange
            Set rngC = Application.Intersect(rngTestRng, ActiveCell)
            If Not rngC Is Nothing Then
                If N.RefersToRange.Address = ActiveCell.Address Then
                    If Left(N.Name, Len(sMasterDropdownTag)) = sMasterDropdownTag Then
                        On Error GoTo 0
                        sActiveCellName = N.Name
                        Set rngMasterList = ActiveCell
                        Set rngSlaveList = Range(sSlaveDropdownTag & Right(N.Name, Len(N.Name) - Len(sMasterDropdownTag)))
                        UpdateValidationLists rngMasterList, rngSlaveList, True
                        Application.EnableEvents = True
                        Exit Sub
                    End If
                End If
            End If
        Next N
    
        On Error GoTo 0
    
    End Sub
    
    
  2. jeff Weir November 22, 2011 at 1:58 pm

    Just realized I wrongly attributed the above approach to Chip Pearson. It was actually from Bob Phillips’ site. http://www.xldynamic.com/source/xld.Dropdowns.html

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: