Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
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
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
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