Drop-Down Menu with Multiple Conditions

[Anshu]

Finally SOLVED!!

Thank you so much Alan Sir for all the help and guidance!!

So here is the next macro version from me: https://excelfox.com/forum/showthrea...ll=1#post14875

This macro works just wow!

I've made some changes in the macro to fulfil the "Part B" case (Point 4,5,6)

Part B)
4. On clicking this cell "R19" a drop down menu appear with 5 option - "Expired" "Divorced" "Break-Up" "Abandonment" "Enter Reason Manually"
5. On selecting an item, it appear in normal color and format
6. On selecting "Enter Reason Manually" from this drop-down, the cell "R19" becomes empty, so that the reason can be entered manually

This is the Macro which finally satisfies my all 7 Point needs. (red color indicates the area I've changed)

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.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
      End With
    Range("J19").Select
        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
        Range("R19:Z19").Select
      With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .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
        Range("R19:Z19").Select
      With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
      End With
        End If
    Else
    ' Target is Not a cell to be acted on
    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
         Range("R19").Select
     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
           
     End If
  Else   ' Target is Not a cell to be acted on
     End If
        
     If Target.Address = "$R$19" Then
        If Target.Value = "Enter Reason Manually" Then
      With Selection.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
  
  End If

End Sub


Sub Oops()
 Let Application.EnableEvents = True
End Sub

For making these changes, I've recorded the macro by Macro recorder, and then organized them in the above code.

This macro works pretty well without any issue.

Thanks!!