UI_2ValidationsUpdate

Apply validation on two cells, when a 3rd cell is changed
When modifying a cell, link two additional cells to show validation based on item selected in 1st cell
Used in one of my apps to make drop-downs (3 Data-validations) linked to each other
Mainly linking two cells to show validations when an item is selected from another cell
Uses CreateList_Matching() function found here

What you need...
ShInput VBE name of sheet having the drop-downs (D21 or Rng, D22 and D23)
DataSheet sheet having lists to connect those three drop-downs
Rng is the range passed into the function, usually comes from Worksheet_Change() event, which expected to have the item selection (Region), in my tool it too has a data-validation.
D22 is cell with validation 1 that depends on Rng
D23 is cell with validation 2 also depends on Rng
List in "DataSheet" sheet (same workbook) has the two lists
A:B and J:K as below ...
A            B
Region    Sub Region

J            K
Region    Product Group

And based on these columns, the function works to identify lists that will be placed in validation in D22 and D23

CodeFunctionName

What is this?

Public

Tested

Original Work

Sub UI_2ValidationsUpdate(Rng As Range)
ShInput.Range("D22").Validation.Delete
ShInput.Range("D23").Validation.Delete
ShInput.Range("D22").ClearContents
ShInput.Range("D23").ClearContents

ListofSubRegions = "Select Region first"
ListofPrdGroups = "Select Region first"

If Rng.Value < > "" Then
ListofSubRegions = "sub1, sub2,main3,fourfor4"
ListofPrdGroups = "grp1,prd2,fgrr3,four4"
ListofSubRegions = CreateList_Matching("B", "A", Rng.Value, 1,, "DataSheet", ",")
ListofPrdGroups = CreateList_Matching("K", "J", Rng.Value, 1,, "DataSheet", ",")
End If

With ShInput.Range("D22").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ListofSubRegions
.InCellDropdown = True
End With
With ShInput.Range("D23").Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=ListofPrdGroups
.InCellDropdown = True
End With

' Auto-select item if it is only one
If ListofSubRegions > "" And InStr(1, ListofSubRegions, ",") = 0 Then ShInput.Range("D22").Value = ListofSubRegions
If ListofPrdGroups > "" And InStr(1, ListofPrdGroups, ",") = 0 Then ShInput.Range("D23").Value = ListofPrdGroups
End Sub

Rng As Range