Multiple Range in Target

[HelloKhritty]

Hi, having a hard time creating program in which I can use 2 targets in a worksheet,
The first one was successful, however, when I'm putting the second target, the code was not running or feels like vb is not reading my code.

my goal is when the target is in Ecell, and the dropdown was changed to "Redirect" Fcell will have the inputmessage "Please provide complete address" and when the dropdown is "send to Payee" the Fcell will have the inputmessage "This cell was disabled" or if possible the Fcell will be diabled and will not accept any input.
So the below codes are for the 1st one, and really running, I'll just need to insert a code for my second problem. hope you can help me. Really appreciate it.



Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Khrit

Application.EnableEvents = False

Dim aCell As Range
Dim RestrictedLength As Long
Dim ecell As Range
Dim Address As String

'~~> Check if the change happened in the range A2:A25
If Not Intersect(Target, Range("A2:A25")) Is Nothing Then
'~~> Check all changed cells (if applicable)
For Each aCell In Target
'~~> Decide the text length
Select Case aCell.Value
Case "UPS": RestrictedLength = 6
Case "FedEx": RestrictedLength = 9
End Select

'~~> Apply the validation
With Range("B" & aCell.Row).Validation
.Delete
.Add Type:=xlValidateTextLength, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:=RestrictedLength
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = "Check Length"
.InputMessage = "You can only enter a maximum of " & _
RestrictedLength & " characters only!"
.ErrorTitle = "Check #"
.ErrorMessage = "You can only enter a maximum of " & _
RestrictedLength & " characters only!"
.ShowInput = True
.ShowError = True
End With
Next aCell


End If

Letscontinue:
Application.EnableEvents = True
Exit Sub
Khrit:
MsgBox Err.Description
Resume Letscontinue
End Sub

 

[DanteAmor]

I made some adjustments to your code. I put the code for the eCell, which I assume is for the "E" column.
And in order not to affect column "F" if in "E" it says: "send to Payee", I used the selectionchange event.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rng As Range, c As Range
  Dim rl As Long  'RestrictedLength
  
  Set rng = Intersect(Target, Range("A2:A25"))
  If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each c In rng
      rl = 0
      If c.Value = "UPS" Then rl = 6
      If c.Value = "FedEx" Then rl = 9
      If rl > 0 Then
        With Range("B" & c.row).Validation
          .Delete
          .Add xlValidateTextLength, xlValidAlertStop, xlEqual, rl
          .IgnoreBlank = True
          .InCellDropdown = True
          .InputTitle = "Check Length"
          .InputMessage = "You can only enter a maximum of " & rl & " characters only!"
          .ErrorTitle = "Check #"
          .ErrorMessage = "You can only enter a maximum of " & rl & " characters only!"
          .ShowInput = True
          .ShowError = True
        End With
      End If
    Next
    Application.EnableEvents = True
  End If
  '
  Set rng = Intersect(Target, Range("E2:E25"))
  If Not rng Is Nothing Then
    Application.EnableEvents = False
    For Each c In rng
      If c.Value = "Redirect" Then
        With Range("F" & c.row).Validation
          .Delete
          .Add xlValidateInputOnly, xlValidAlertStop, xlBetween
          .IgnoreBlank = True
          .InCellDropdown = True
          .InputTitle = ""
          .InputMessage = "Please provide complete address"
          .ErrorTitle = ""
          .ErrorMessage = ""
          .ShowInput = True
          .ShowError = True
        End With
      End If
    Next
    Application.EnableEvents = True
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim rng As Range, c As Range
  Set rng = Intersect(Target, Range("F2:F25"))
  If Not rng Is Nothing Then
    For Each c In rng
      If LCase(Range("E" & c.row)) = LCase("send to Payee") Then
        Range("E" & c.row).Select
      End If
    Next
  End If
End Sub

 

[HelloKhritty]

Works perfectly well. You really are a genius. Thank you soooooooo much

 

[DanteAmor]

Im glad to help you. Thanks for the feedback