Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

In support of this püost:
https://excelfox.com/forum/showthrea...ll=1#post14877

Private Sub Worksheet_Change(ByVal Target As Range) '   https://excelfox.com/forum/showthread.php/2624-Drop-Down-Menu-with-Multiple-Conditions?p=14873&viewfull=1#post14873
    If Target.Address = "$J$19" Or Target.Address = "$J$19:$P$19" Then  '  we need  "$J$19:$P$19"  to make macro work on  Delete  probably because of merged cells
    Dim RngTgt As Range: Set RngTgt = Target
        If Target.Address = "$J$19:$P$19" Then Set RngTgt = Range("J19")
        If RngTgt.Value = "" Then
         Let Application.EnableEvents = False
         Let RngTgt.Value = "(Select Here)"
         Let Range("R19").Value = ""
         Let Application.EnableEvents = True
         Let RngTgt.Font.Color = 10855845
'    Range("R19:Z19").Select
'      With Selection
'        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlCenter
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = True
'      End With
        ElseIf RngTgt.Value = "Nuclear Family" Or RngTgt.Value = "Joint Family" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Remark if any)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
        ElseIf RngTgt.Value = "Single-Parent Family" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Select Reason)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
'       The drop down validation list in cell R19  is produced when the value "Single-Parent Family" is selected in cell J19
                                 '    Range("R19").Select
            With Range("R19").Validation                 'With Selection.Validation
              .Delete
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
              xlBetween, Formula1:="Expired,Divorced,Break-Up,Abandonment,Enter Reason Manually"
              .IgnoreBlank = True
              .InCellDropdown = True
              .InputTitle = ""
              .ErrorTitle = "Error!"
              .InputMessage = ""
              .ErrorMessage = "To enter the reason manually, please select the option 'Enter Reason Manually'"
              .ShowInput = True
              .ShowError = True
            End With
                
        ElseIf RngTgt.Value = "Uncategorised" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Please Specify the Case)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
        End If ' end of all values of J19 to  result in actions
    Else
    ' Target is not cell J19  ( or  J19:P19 )
    End If

'    If Target.Address = "$R$19" Then Let Target.Font.ColorIndex = xlAutomatic
'
'    If Target.Address = "$J$19" Then
'        If Target.Value = "Single-Parent Family" Then
'         Let Application.EnableEvents = False
'         Let Range("R19").Value = "Select Reason..."
'         Let Application.EnableEvents = True
'       With Range("R19").Font
'        .Color = -10477568
'        .TintAndShade = 0
'       End With
''         Target.Font.Size = 11.5
'
'     End If

        
'    If drop down list is present in cell R19 , and "Enter Reason Manually" is selected from that drop down list in R19, then the drop down validation list in cell R19  is removed.
        
     If Target.Address = "$R$19" Then
      Let Target.Font.ColorIndex = xlAutomatic
        If Target.Value = "Enter Reason Manually" Then
'            With Target.Validation ' Selection.Validation
'              .Delete
             Target.Validation.Delete
'              .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
'              :=xlBetween
'              .IgnoreBlank = True
'              .InCellDropdown = True
'              .ShowInput = True
'              .ShowError = True
'            End With
'         Selection.ClearContents
'      With Target.Font
'        .ThemeColor = xlThemeColorLight1
'        .TintAndShade = 0
'       End With
'       Range("R19:Z19").Select
'    With Selection
'        .HorizontalAlignment = xlLeft
'        .VerticalAlignment = xlCenter
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlContext
'        .MergeCells = True
'    End With
'        Target.Font.Size = 11.5
     End If
  Else
  ' Target is not R19
  End If


End Sub

Private Sub Worksheet_Change(ByVal Target As Range) '   https://excelfox.com/forum/showthread.php/2624-Drop-Down-Menu-with-Multiple-Conditions?p=14873&viewfull=1#post14873
    If Target.Address = "$J$19" Or Target.Address = "$J$19:$P$19" Then  '  we need  "$J$19:$P$19"  to make macro work on  Delete  probably because of merged cells
    Dim RngTgt As Range: Set RngTgt = Target
        If Target.Address = "$J$19:$P$19" Then Set RngTgt = Range("J19")
        If RngTgt.Value = "" Then
         Let Application.EnableEvents = False
         Let RngTgt.Value = "(Select Here)"
         Let Range("R19").Value = ""
         Let Application.EnableEvents = True
         Let RngTgt.Font.Color = 10855845
        ElseIf RngTgt.Value = "Nuclear Family" Or RngTgt.Value = "Joint Family" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Remark if any)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
        ElseIf RngTgt.Value = "Single-Parent Family" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Select Reason)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
'       The drop down validation list in cell R19  is produced when the value "Single-Parent Family" is selected in cell J19
            With Range("R19").Validation
              .Delete
              .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
              xlBetween, Formula1:="Expired,Divorced,Break-Up,Abandonment,Enter Reason Manually"
              .IgnoreBlank = True
              .InCellDropdown = True
              .InputTitle = ""
              .ErrorTitle = "Error!"
              .InputMessage = ""
              .ErrorMessage = "To enter the reason manually, please select the option 'Enter Reason Manually'"
              .ShowInput = True
              .ShowError = True
            End With

        ElseIf RngTgt.Value = "Uncategorised" Then
         Let Application.EnableEvents = False
         Let Range("R19").Value = "(Please Specify the Case)"
         Let Application.EnableEvents = True
         Let Range("R19").Font.Color = 10855845
         Let RngTgt.Font.Color = 6751362
        End If ' end of all values of J19 to  result in actions
    Else
    ' Target is not cell J19  ( or  J19:P19 )
    End If

'    If drop down list is present in cell R19 , and "Enter Reason Manually" is selected from that drop down list in R19, then the drop down validation list in cell R19  is removed.
   If Target.Address = "$R$19" Then
    Let Target.Font.ColorIndex = xlAutomatic
      If Target.Value = "Enter Reason Manually" Then
      Target.Validation.Delete
      Else
      End If
   Else
    ' Target is not R19
   End If

End Sub