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 lineDim RngTgt As Range: Set RngTgt = Target, and Case 4 have lineDim RT As Range: Set RT = TargetI 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)??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??
Reply With Quote
Bookmarks