Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Shows dropdown entries for reference columns
Dim blnSub As Boolean
Dim clOffset As Long
Dim strFormula1 As String

  If Target.Count > 1 Then Exit Sub
  If Target.row < 6 Then Exit Sub
  
  Select Case Target.column
  
    Case 3
      strFormula1 = "=Drivers"
    Case 5
      strFormula1 = "=Category"
    Case 6
    'consider guidelines of user interface in functional areas:
    'like data entry, data display, sequence control,  data transmission, and data protection
      If Len(Target.Formula) > 0 Then
        strFormula1 = "=" & Target.Formula
        blnSub = True
      End If
    Case 10
      strFormula1 = "=Organizational_level"
    Case Else
      Exit Sub
  End Select
  
  clOffset = 1
  If ChkValidation(blnSub, clOffset, Len(Target.Formula), Target.Offset(0, clOffset), _
    3, 1, 1, strFormula1) Then Target.Offset(0, clOffset).Select
  
End Sub

Private Function ChkValidation(IsSub As Boolean, IsOffset As Long, _
  tLen As Long, vCell As Range, _
  vlType As XlDVType, vlStyle As XlDVAlertStyle, vlOperator As XlFormatConditionOperator, _
  vlFormula1 As Variant, Optional vlFormula2 As Variant) As Boolean

'On Error GoTo errh
  If Len(vCell.Validation.Parent) > 0 Then
    If tLen = 0 Then
      Application.EnableEvents = False
      vCell.Validation.Delete
      vCell.Formula = vbNullString
      If IsSub Then
        vCell.Offset(0, IsOffset).Validation.Delete
        vCell.Offset(0, IsOffset).Formula = vbNullString
      End If
    End If
  Else
    If tLen > 0 Then
      vCell.Validation.Delete
      vCell.Validation.Add Type:=vlType, AlertStyle:=vlStyle, _
        Operator:=vlOperator, Formula1:=vlFormula1, Formula2:=vlFormula2
      With vCell.Validation
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .Errormessage = ""
        .ShowInput = False
        .ShowError = True
      End With
    End If
  End If

errh:
If Err.number = 0 Then ChkValidation = True
Application.EnableEvents = True
End Function