Private Sub Worksheet_Change(ByVal Target As Range) not working

[Benders]

Column A may have entries like A001, A002...A00n! For certain such entries a message box should pop up if the corresponding 'Fruits' are not found in Row 23. I tried the following code but cannot get it to work. Where am I going wrong?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Target.Count > 1 Then Exit Sub
    
    If Target.Column = 1 Then
    Cur_row = ActiveCell.Row
            If Range("A" & Cur_row).Value = "A001" Or Range("A" & Cur_row).Value = "A002" Or Range("A" & Cur_row).Value = "A003" Then
           
                 Rows("23:23").Select
                    On Error Resume Next
                    Cells.Find(What:="Apples", After:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
            If Err.Number = 91 Then
            MsgBox ("Please select Button3 to add Apples")
            End
            Else
            GoTo Letscontinue
            End If
           
    Else
      
            If Range("A" & Cur_row).Value = "A004" Then
    
                Rows("23:23").Select
                    On Error Resume Next
                    Cells.Find(What:="Bananas", After:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
            If Err.Number = 91 Then
            MsgBox ("Please select Button3  to add Bananas")
            End
            Else
            GoTo Letscontinue
            End If
    Else
    
            If Range("A" & Cur_row).Value = "A005" Then
            
                Rows("23:23").Select
                    On Error Resume Next
                    Cells.Find(What:="Grapes", After:=ActiveCell, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate
            If Err.Number = 91 Then
            MsgBox ("Please select Button3  to add Grapes")
            End
            Else
            GoTo Letscontinue
            End If
            
    Else
            GoTo Letscontinue
            End If
            End If
            End If

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

 

[Benders]

Both Messages should appear. No there will not be more than two.

P.S: Thanks for your patience. I should also look for forums that suggest (a) how to avoid useless meetings/Conf calls and (b) How to say 'No' and mean it!

 

[RoryA]

Untested, but try this:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim sFruit                      As String
   Dim vFruits
   Dim n                           As Long
   On Error GoTo Whoa

   If Target.Count > 1 Then Exit Sub

   If Target.Column = 1 Then
      Select Case Target.Value
         Case "A001", "A002", "A003"
            sFruit = "Apples|Guavas"
         Case "A004"
            sFruit = "Bananas"
         Case "A005"
            sFruit = "Grapes"
      End Select

      If Len(sFruit) > 0 Then
         vFruits = Split(sFruit, "|")
         For n = LBound(vFruits) To UBound(vFruits)
            If IsError(Application.Match(vFruits(n), Rows("23:23"), 0)) Then MsgBox "Please select Button3 to add " & vFruits(n)
         Next n
      End If

   End If

   Exit Sub
Whoa:
   MsgBox Err.Description
End Sub

 

[Benders]

You nailed it. Cheers Mate. Much Appreciated.

 

[RoryA]

My pleasure.