Dynamic data validation lists - from multiple select

Hi All

im hoping somebody can help, on getting me started on the below query

i have a relationship in excel which i want to use to dynamically filter a data validation list based on selection of the parent Collum, i have done this before but this time have added some VBA code which allows a user to select multiple options from the parent drop down




Please see attached example of data and desired output, for example if a user selects A & B from the parent drop down i want the next column to only filter the related items so in this case 1,2,3



Any help is greatly appreciated

Pl read the yellow banner on the top.

Code for validation in B column is given in Worksheet event. I have added my code at the end of your code.
Column A validation is not possible as you have shown. Type manually in A column. I have removed validation for column A.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String

Application.EnableEvents = True

On Error GoTo Exitsub

If Not Intersect(Target, Range("A:A")) Is Nothing Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If

Application.EnableEvents = True

Exitsub:

Application.EnableEvents = True

'Validation for B column
If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Cells.Count = 1 Then
Dim S As String
Dim M, A
Dim T As Long, Ta As Long
Application.EnableEvents = False

M = Target.Value
A = Sheets("Data").Range("A1").CurrentRegion.Offset(1, 0)
With CreateObject("Scripting.dictionary")
    For Ta = 1 To UBound(A, 1) - 1
    If InStr(1, M, A(Ta, 1)) > 0 Then .Add Ta, A(Ta, 2)
    Next Ta
N = .items
M = N(0)
End With

    With Target.Offset(0, 1).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(N, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

Application.EnableEvents = True
End If

End Sub