Akuini
Well-known Member
- Joined
- Feb 1, 2016
- Messages
- 5,260
- Office Version
- 365
- Platform
- Windows
I want to share a macro to set up multi dependent data validation with vba. Some versions of dependent data validation use formulas to set them up, usually with indirect functions. For 2 or 3 dependent data validation & small data set, it's pretty easy to set it up, but for more than 3, it might be difficult to maintain as it requires lots of tables & lots of helper columns. This version uses vba, you only need 1 table, 1 helper column & 1 named range. The code is a bit complicated but easy to set up and maintain.
This is an example of 3 dependent data validation, with VBA. You can easily set up more than 3 dependent data validations as needed.
Notes:
1. You only need 1 table as data validation source, 1 helper column, 1 named range & 1 simple formula in data validation (ie =xName).
2. The columns where data validation reside may or may not be contiguous.
3. The list in the table may have duplicate, empty & unsorted, but the code will make the list in data validation unique, sorted & non-empty. The list is also dynamic, you can add more data as needed.
4. In the range with data validation, changing or deleting cell contents will delete cells in the next column with data validation.
5. But one caveat of using macro is when macro changes/writes something on sheet it will delete Undo Stack, so at that time you can't use UNDO. In this case it happens every time you put the cursor in a cell with data validation.
The File:
The code:
This is an example of 3 dependent data validation, with VBA. You can easily set up more than 3 dependent data validations as needed.
Notes:
1. You only need 1 table as data validation source, 1 helper column, 1 named range & 1 simple formula in data validation (ie =xName).
2. The columns where data validation reside may or may not be contiguous.
3. The list in the table may have duplicate, empty & unsorted, but the code will make the list in data validation unique, sorted & non-empty. The list is also dynamic, you can add more data as needed.
4. In the range with data validation, changing or deleting cell contents will delete cells in the next column with data validation.
5. But one caveat of using macro is when macro changes/writes something on sheet it will delete Undo Stack, so at that time you can't use UNDO. In this case it happens every time you put the cursor in a cell with data validation.
The File:
dhee - multiple data validation, dependent, dict, non-adjacent column - 4
MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.
www.mediafire.com
The code:
VBA Code:
Option Explicit
'=================================================================================================
'=============== ADJUST THE CODE IN THIS PART: ===================================
'sheet's name where the list for data validation is located. [in the example: sheet "sheet2"]
Private Const sList As String = "sheet2"
'table's name where the list for data validation is located. [in the example: "Table1"]
Private Const sTable As String = "Table1"
'sDT & sDV must be in correct order (in this example 'STATE > CITY > REP).
'You can add number of columns as needed.
'Column number on the table "Table1": 'STATE > CITY > REP
Private Const sDT As String = "1,2,4"
'Column where data validation is located 'STATE > CITY > REP
Private Const sDV As String = "B:B,D:D,G:G"
'the helper column, first cell
Private Const xH As String = "H1"
'the name range as the source of data validation
Private Const xN As String = "xName"
'==================================================================================================
'==================================================================================================
Private xOld As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range(sDV)) Is Nothing Then
If isValid(Target) Then 'if activecell has data validation type 3
If Target.Validation.Formula1 = "=" & xN Then 'its formula is "=xName"
Dim d As Object, va, flag As Boolean, z, q, vb, x
Dim i As Long, y As Long, w As Long
Application.CutCopyMode = False 'prevent paste to the range with the DV
xOld = Target.Value
Set d = CreateObject("scripting.dictionary"): d.CompareMode = vbTextCompare
'columns with data validation: sDV = "B:B,D:D,G:G"
z = Application.Transpose(Application.Transpose(Split(sDV, ","))) ''create 1D array, variant/string type, Lbound = 1
For i = 1 To UBound(z)
If Target.Column = Range(z(i)).Column Then w = i: Exit For
Next
'reset xName to blank
' ThisWorkbook.Names(xN).RefersTo = Sheets(sList).Range(xH)
Sheets(sList).Range(xH).Name = xN 'blank cell
If w > 1 Then 'if previous col with DV is empty then exit sub (with xName is blank)
If ActiveSheet.Cells(Target.Row, z(w - 1)) = "" Then Exit Sub
End If
'Column number on the source table: sDT = "1,2,4"
q = Evaluate("{" & sDT & "}") 'create 1D array, variant/double type, Lbound = 1
'populate data from Table1,
'"Application.Max(q)" is to limit the column range as needed for populating the list.
va = Sheets(sList).ListObjects(sTable).DataBodyRange.Resize(, Application.Max(q)).Value
For i = 1 To UBound(va, 1)
flag = True
If w = 1 Then 'if target is in first data validation column
d(va(i, q(w))) = Empty
Else
'apply criteria from all previous column
For y = 1 To w - 1
If UCase(va(i, q(y))) <> UCase(ActiveSheet.Cells(Target.Row, z(y))) Then flag = False: Exit For
Next
'if all criteria are met
If flag = True Then d(va(i, q(w))) = Empty
End If
Next
If d.Exists("") Then d.Remove ""
If d.Count > 0 Then
Dim c As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
'populate d.keys to helper column & sort it
With Sheets(sList)
.Columns(.Range(xH).Column).ClearContents
Set c = .Range(xH).Resize(d.Count, 1).Offset(1)
c = Application.Transpose(Array(d.Keys))
c.Sort Key1:=c.Cells(1), Order1:=xlAscending, Header:=xlNo
End With
'populating range to xName
c.Name = xN
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End If
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range(sDV)) Is Nothing Then
If isValid(Target) Then 'if activecell has data validation type 3
If Target.Validation.Formula1 = "=" & xN Then 'if its formula is "=xName"
If xOld <> Target.Value Then
Dim i As Long, w As Long, z
Application.EnableEvents = False
'columns with data validation: "B:B,D:D,G:G"
z = Application.Transpose(Application.Transpose(Split(sDV, ",")))
For i = 1 To UBound(z)
If Target.Column = Range(z(i)).Column Then w = i: Exit For
Next
'if it's not the last column with DV then clear all next column with DV
If w < UBound(z) Then
For i = w + 1 To UBound(z)
ActiveSheet.Cells(Target.Row, Range(z(i)).Column) = ""
Next
End If
Application.EnableEvents = True
End If
End If
End If
End If
End Sub
Sub toEnableEvent()
Application.EnableEvents = True
End Sub
Function isValid(f As Range) As Boolean
Dim v
On Error Resume Next
v = f.Validation.Type
On Error GoTo 0
isValid = v = 3
End Function
