Show error message when word in text string isn't in approved list.

[KyleJackMorrison]

Hello, i would like a code that will show when a user enters a string of text and there isn't a word in that string that doesn't meet the approved list.

Approved list:
'World'
'Planet'
'Globe'
'Earth'

If someone enters in a cell "Hello World' or 'What is Earth' nothing will show,
but if someone says 'Hello John' it to show an error saying, you must use one of the approved words.

TIA

 

[DanteAmor]

It is advisable to put your list of words on a sheet, for example, create a sheet called "list" in column A put the words.
Now put the following code in the events of your sheet where you want to validate.

Now, everything you capture in column B will be validated. Change "B:B" to the column where you want the validation.

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Not Intersect(Target, Range("[B][COLOR=#ff0000]B:B[/COLOR][/B]")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Dim word As Variant, i As Long, b As Range, exists As Boolean
        
        exists = False
        word = Split(Target, " ")
        For i = 0 To UBound(word)
            Set b = Sheets("list").Range("A:A").Find(word(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not b Is Nothing Then
                exists = True
                Exit For
            End If
        Next
        If exists = False Then
            MsgBox "You must use one of the approved words"
            Application.EnableEvents = False
            Target.Value = ""
            Application.EnableEvents = True
        End If
    End If
End Sub

SHEET EVENT
Right click the tab of the sheet you want this to work, select view code & paste the code into the window that opens up.

 

[Reggie Perrin]

If Range"A1".value like "*Earth*" Then
             Else
                MsgBox "Word not allowed"
           End If

 

[KyleJackMorrison]

@Dante,

Awesome works great. Don't suppose you could show me how to tweek it to not display the message if i double click the cell and its an empty cell?

 

[DanteAmor]

@Dante,

Awesome works great. Don't suppose you could show me how to tweek it to not display the message if i double click the cell and its an empty cell?

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
[B][COLOR=#0000ff]        If Target.Value = "" Then Exit Sub[/COLOR][/B]
        Dim word As Variant, i As Long, b As Range, exists As Boolean
        
        exists = False
        word = Split(Target, " ")
        For i = 0 To UBound(word)
            Set b = Sheets("list").Range("A:A").Find(word(i), LookIn:=xlValues, lookat:=xlWhole)
            If Not b Is Nothing Then
                exists = True
                Exit For
            End If
        Next
        If exists = False Then
            MsgBox "You must use one of the approved words"
            Application.EnableEvents = False
            Target.Value = ""
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[KyleJackMorrison]

@Dante,

You're the best! Thank you!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.