Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim rngRef As Excel.Range
Dim rngArea As Excel.Range
Dim rngCells As Excel.Range
Dim rngCell As Excel.Range
Set rngRef = Columns("C")
Set rngCells = Intersect(Target, rngRef)
If Not rngCells Is Nothing Then
For Each rngArea In rngCells.Areas
For Each rngCell In rngArea.Cells
With Cells(rngCell.row, "D")
If Trim$(rngCell.Value) <> "" Then
Call .Validation.Delete
Call .ClearContents
Call .Validation.Add(xlValidateList, Formula1:="=Drivers")
Else
Call .Validation.Delete
Call .ClearContents
End If
End With
Next
Next
End If
Dim rngRef2 As Excel.Range
Dim rngArea2 As Excel.Range
Dim rngCells2 As Excel.Range
Dim rngCell2 As Excel.Range
Set rngRef2 = Columns("E")
Set rngCells2 = Intersect(Target, rngRef2)
If Not rngCells2 Is Nothing Then
For Each rngArea2 In rngCells2.Areas
For Each rngCell2 In rngArea2.Cells
With Cells(rngCell2.row, "F")
If Trim$(rngCell2.Value) <> "" Then
Call .Validation.Delete
Call .ClearContents
Call .Validation.Add(xlValidateList, Formula1:="=Category")
Else
Call .Validation.Delete
Call .ClearContents
End If
End With
Next
Next
End If
Dim rngRef3 As Excel.Range
Dim rngArea3 As Excel.Range
Dim rngCells3 As Excel.Range
Dim rngCell3 As Excel.Range
Set rngRef3 = Columns("J")
Set rngCells3 = Intersect(Target, rngRef3)
If Not rngCells3 Is Nothing Then
For Each rngArea3 In rngCells3.Areas
For Each rngCell3 In rngArea3.Cells
With Cells(rngCell3.row, "K")
If IsEmpty(rngCell3.Value) Then
Call .Validation.Delete
Call .ClearContents
Else
Call .Validation.Delete
Call .ClearContents
Call .Validation.Add(xlValidateList, Formula1:="=Organizational_level")
End If
End With
Next
Next
End If
SafeExit:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Error " & Err.number)
GoTo SafeExit
End Sub