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

 

[RoryA]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim sFruit                      As String
   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"
         Case "A004"
            sFruit = "Bananas"
         Case "A005"
            sFruit = "Grapes"
      End Select
      
      If IsError(Application.Match(sFruit, Rows("23:23"), 0)) Then MsgBox "Please select Button3 to add " & sFruit
      
   End If
   
   Exit Sub
Whoa:
   MsgBox Err.Description
End Sub

 

[Benders]

Thank you very much. This works like a charm. Learnt a lot of things from your code today.

I still have a long way to go...

 

[RoryA]

Glad to help, and welcome to the forum!

 

[Benders]

Sorry but I am again facing issues with the code. It seems that for any other entry viz A006 or A007 in column A, the message "Please select Button3 to add " comes up without any value in <sFruit>. The code should simply do nothing for any other entry except from A001-A005.
Also it seems that once the macro in Button 3 is pressed, it somehow deactivates this macro and upon entering A001 -A005 in Column A nothing happens? Should I be adding Application.EnableEvents = True at the end of this code or the other codes I have?

 

[RoryA]

Sorry - I should have caught that:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim sFruit                      As String
   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"
         Case "A004"
            sFruit = "Bananas"
         Case "A005"
            sFruit = "Grapes"
      End Select
      
      If len(sFruit) > 0 then 
         If IsError(Application.Match(sFruit, Rows("23:23"), 0)) Then MsgBox "Please select Button3 to add " & sFruit
      End If
      
   End If
   
   Exit Sub
Whoa:
   MsgBox Err.Description
End Sub

I can't really comment on Button3 as I have no idea what it does.

 

[Benders]

Thanks for the quick reply. It does solve the first part of the question. Given below is the code in Button3. Really can't understand why on executing this macro for Button3 the Private Sub Change by By Val should stop working.

Sub ClearAll()
'
' 
'
'
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Worksheets("Fruits")
lastCol = LastColumn(ws)
Last_Col = Split(ActiveSheet.Cells(, lastCol).Address, "$")(1)
    
Sheets("Fruits").Select
    Range("B5:B19,F5:F19").Select
    Selection.ClearContents
    Range("A24:B123").Select
    Selection.ClearContents
    Range("D24:O123").Select
    Selection.ClearContents

    Sheets("Fruits").Select

If Last_Col = "O" Then
 GoTo ErrorHandler
Else
     Columns("P:" & Last_Col).Select
     Selection.Delete Shift:=xlToLeft
     Range("B2").Select
End If
Range("B2").Select
Exit Sub
Application.ScreenUpdating = True

ErrorHandler:
Exit Sub
Application.ScreenUpdating = True
End Sub

 

[RoryA]

I can't see why that would break it, but you probably don't want the change event triggered by that code. Try changing it to:

Sub ClearAll()
'
'
'
'
   Dim ws                          As Worksheet
   Set ws = Worksheets("Fruits")

   On Error GoTo ErrorHandler
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
   End With

   lastCol = LastColumn(ws)
   Last_Col = Split(ActiveSheet.Cells(, lastCol).Address, "$")(1)

   With ws
      .Activate
      .Range("B5:B19,F5:F19").ClearContents
      .Range("A24:B123").ClearContents
      .Range("D24:O123").ClearContents

      If Last_Col <> "O" Then .Columns("P:" & Last_Col).Delete Shift:=xlToLeft
      .Range("B2").Select
   End With

exit_here:
   With Application
      .EnableEvents = True
      .ScreenUpdating = True
   End With
   Exit Sub

ErrorHandler:
   Resume exit_here
End Sub

 

[Benders]

Thanks. This does improve the Button3 macro working but has absolutely no effect on the Private Change by Val. Infact I saved, closed the workbook, quit Excel and reopened it again. Without even touching Button3, the Private Change by Val will not work. The code was working fine this morning until I executed the ClearAll macro.

 

[RoryA]

Can you post the workbook somewhere?