Hi!
Here I added some more event macro in the same sheet. "Case 1", "Case 3" and "Case 4" are added. "Case 2" is the same Macro discussed above.
I have 2 question here...Code:Private Sub Worksheet_Change(ByVal Target As Range)
' Case 1
If Target.Address = "$I$20" Or Target.Address = "$U$20" Or Target.Address = "$Z$20" Then
If Target.Value = "" Then ' case a cell was emptied
Let Application.EnableEvents = False
Let Target.Value = ChrW(&H270F)
Let Application.EnableEvents = True
Let Target.Font.Color = -3817475
Target.Font.Size = 9
Else ' case a text was entered
Let Target.Font.Color = -12316781
Target.Font.Size = 12
End If
Else ' Target is Not a cell to be acted on
End If
' Case 2
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").Validation.Delete
Range("R19").ClearComments
ElseIf RngTgt.Value = "Nuclear Family" Or RngTgt.Value = "Joint Family" Then
Let Application.EnableEvents = False
Let Range("R19").Value = "(Remarks if any...)"
Let Application.EnableEvents = True
Let Range("R19").Font.Color = 10855845
Let RngTgt.Font.Color = 6751362
Range("R19").Validation.Delete
Range("R19").Select
Range("R19").ClearComments
ElseIf RngTgt.Value = "Single-Parent Family" Then
Let Application.EnableEvents = False
Let Range("R19").Value = "(Select Reason for Single-Parent)"
Let Application.EnableEvents = True
Let Range("R19").Font.Color = 10855845
Let RngTgt.Font.Color = 6751362
With Range("R19").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="Expired {One is No More},Divorced {Separated Legally},Break-Up {Attachment Hampered},Abandonment {Fully Separated},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
Range("R19").Select
Range("R19").AddComment
Range("R19").Comment.Visible = False
Range("R19").Comment.Text Text:="Reason for Single-Parent"
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").Validation.Delete
Range("R19").Select
Range("R19").ClearComments
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.Value = "Enter Reason Manually" Then
Target.Validation.Delete
Target.Value = ""
Else
End If
Else ' Target is not R19
End If
' Case 3
If Target.Address = "$J$21" Or Target.Address = "$J$21:$P$21" Then
Dim RT As Range: Set RT = Target
If Target.Address = "$J$21:$P$21" Then Set RT = Range("J21")
If RT.Value = "" Then
Let Application.EnableEvents = False
Let RT.Value = "(Select Here)"
Let Range("R21").Value = ""
Let Application.EnableEvents = True
Let RT.Font.Color = 10855845
ElseIf Not IsEmpty(RT.Value) Then
Let Application.EnableEvents = False
Let Range("R21").Value = "(Remarks if any...)"
Let Application.EnableEvents = True
Let Range("R21").Font.Color = 10855845
Let RT.Font.Color = 6751362
Range("R21").Select
End If
Else
End If
If Target.Address = "$R$21" Then
Let Target.Font.ColorIndex = xlAutomatic
End If
' Case 4
If Target.Address = "$J$22" Or Target.Address = "$J$22:$P$22" Then
Dim T As Range: Set T = Target
If Target.Address = "$J$22:$P$22" Then Set T = Range("J22")
If T.Value = "" Then
Let Application.EnableEvents = False
Let T.Value = "(Select Here)"
Let Range("R22").Value = ""
Let Application.EnableEvents = True
Let T.Font.Color = 10855845
ElseIf Not IsEmpty(T.Value) Then
Let Application.EnableEvents = False
Let Range("R22").Value = "(Remarks if any...)"
Let Application.EnableEvents = True
Let Range("R22").Font.Color = 10855845
Let T.Font.Color = 6751362
Range("R22").Select
End If
Else
End If
If Target.Address = "$R$22" Then
Let Target.Font.ColorIndex = xlAutomatic
End If
End Sub
1. Case 2 have line,Case 3 have lineQuote:
Dim RngTgt As Range: Set RngTgt = Target
, and Case 4 have lineQuote:
Dim RT As Range: Set RT = Target
I have more than 20 cases which are to be added in the same event macro given above. So is it necessary for me to define the range everytime with a new name (as RngTgt, RT & T)??Quote:
Dim T As Range: Set T = Target
Or there is some other easy method available to solve such cases??
2. Case 3 and Case 4 are almost same. The only difference is - Case 3 work on Row 21, while Case 4 work on Row 22. So, is it good to keep them as they are, or there is any way to merge and refine them??
