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


Public

Tested

My Own 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

Views 312 Downloads 79

VBA-Excel Components
ANmarAmdeen
747
Attachments
Revisions

v1.0