VBA Pop Up Message Query

[tumblingbay]

All,

Happy new year to everyone - I have another headache caused by VBA and am sure I'm missing something obvious!

I have a spreadsheet in which I require a pop up message to appear when a user enters certain criteria into a cell, specifically the letters 'AAP'. I have the following code on each sheet and it works a treat; however, the message seems to fire when ANYTHING is entered into a cell!

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Set rng = Range("C6:I30")
If Not Intersect(Target, rng) Is Nothing Then
On Error Resume Next
If rng = "AAP" Or "aap" Then
MsgBox "Please provide a reason for AAP"

End If
End If
Set rng = Nothing
End Sub

One other thing, I had to paste this into each worksheet (nearly 50 in toal) in order that it work - when I tried to paste into 'This Workbook' it wouldn't work at all?!
Any suggestions will be very welcome.
Thanks in advance,
TB

 

[VoG]

Try

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Set rng = Range("C6:I30")
If Not Intersect(Target, rng) Is Nothing Then
    If UCase(Target.Value) = "AAP" Then
        MsgBox "Please provide a reason for AAP"
    End If
End If
End Sub

 

[Jaafar Tribak]

Maybe this : (code in the workbook module)

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim rng As Range
    
    Set rng = Range("C6:I30")
        If Not Intersect(Target, rng) Is Nothing Then
    '    On Error Resume Next
            If UCase(Target) = "AAP" Then
                MsgBox "Please provide a reason for AAP"
            End If
        End If
    Set rng = Nothing

End Sub

 

[tumblingbay]

Thank you both so much - works great!