Macros

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mainSrc As String
Dim iMainSrcCol As Integer
Dim subSrc As String
Dim iSubSrcCol As Long

Dim lThisRow As Long
Dim Cell As Range
Dim lMinTargetRow As Long

Dim sValidationSrcSheet As String
Dim rngValidationSrcCell As Range
Dim iValidationSrcCol As Integer
Dim lValidationSrcRow As Long
Dim sValidationSrcAdd As String
Dim sValidatationStartAddress As String
Dim sValidatationEndAddress As String

    iMainSrcCol = 4
    iSubSrcCol = 5
    lMinTargetRow = 4
    
    sValidatationStartAddress = "$N$3"
    sValidatationEndAddress = "$AP$3"
    
    sValidationSrcSheet = ActiveSheet.Name
    
    On Error GoTo Error_Handler
    
    Application.EnableEvents = False
    
    For Each Cell In Target
      
        If Cell.Column <> iMainSrcCol Then GoTo Next_Cell
        If Cell.Row < lMinTargetRow Then GoTo Next_Cell
          
        mainSrc = Cell
        lThisRow = Cell.Row
        
        If mainSrc = "" Then
            Cells(lThisRow, iSubSrcCol).Validation.Delete
            Cells(lThisRow, iSubSrcCol) = ""
            GoTo Next_Cell
        End If

        
        On Error Resume Next
            subSrc = Cells(lThisRow, iSubSrcCol).Validation.Formula1
        'On Error GoTo Error_Handler
        On Error GoTo 0
        If ("=" & subSrc = mainSrc) Then
            GoTo Next_Cell
        End If
        
        Set rngValidationSrcCell = Sheets(sValidationSrcSheet).Range(sValidatationStartAddress & ":" & sValidatationEndAddress).Find(mainSrc, Range(sValidatationStartAddress), LookAt:=xlWhole, SearchDirection:=xlNext, SearchOrder:=xlByRows)
        
        If (rngValidationSrcCell Is Nothing) Then GoTo Next_Cell
        
        iValidationSrcCol = rngValidationSrcCell.Column
        lValidationSrcRow = Cells(Rows.Count, iValidationSrcCol).End(xlUp).Row
        
        sValidationSrcAdd = Range(Cells(rngValidationSrcCell.Row + 1, iValidationSrcCol), Cells(lValidationSrcRow, iValidationSrcCol)).Address
        
        Cells(lThisRow, iSubSrcCol) = ""
        With Cells(lThisRow, iSubSrcCol).Validation
            .Delete
           '.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='" & sValidationSrcSheet & "'!" & sValidationSrcAdd
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & sValidationSrcAdd
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = "This is my Input Title"
            .ErrorTitle = "Oops Error"
            .InputMessage = "Select a Value"
            .ErrorMessage = "Not a valid value"
            .ShowInput = True
            .ShowError = True
        End With
    
Next_Cell:

    Next Cell
    
End_Sub:
    
    Application.EnableEvents = True
    Set Cell = Nothing
    Exit Sub

Error_Handler:
    MsgBox Err.Description
    GoTo End_Sub
    
End Sub