Method to highlight any cell that contains anything but 'allowed' set of words

[redfuse]

Hi all,

For a linguistic project at university I'm looking for a way to do the following:
I have a data set containing text (no numbers) that spans several columns and rows. I have a list of 'allowed' words (about 100 words) that can be in these cells. If a cell contains a sentence with a word that is anything other than these allowed words it should be somehow marked. Ideally the 'wrong' word itself is marked, but it would already be very helpful if the cell that contains the word is marked in some way.
I tried conditional formatting, but it seems to only allow formatting cells that contain a certain word, not if it doesn't contain certain words. Is there a function or a script that would be able to do this? Thanks in advance!

------

Simplified example:

Say you have four allowed words:
Apple
Pear
Orange
Banana

You have the following cells:

>Apple Banana
>Pear Pear Orange Pear
>Banana Apple Orange Kiwi

The third cell should be marked because it contains a word outside of the set.

[tigeravatar]

redfuse,

Attached is an example workbook based on the criteria you described.
It has two sheets, 'Sheet1' and 'Allowed Words'
In 'Allowed Words' column A is the list of allowed words
In 'Sheet1' column A is the list of data (text strings) and there is also a button labelled "Find Disallowed Words" which is assigned to the following macro:

Sub tgr()
    
    Dim wsData As Worksheet
    Dim wsAllowed As Worksheet
    Dim rngData As Range
    Dim rngAllowed As Range
    Dim DataCell As Range
    Dim varWord As Variant
    
    Set wsData = Sheets("Sheet1")
    Set rngData = wsData.Range("A2", wsData.Cells(Rows.Count, "A").End(xlUp))
    If rngData.Row < 2 Then Exit Sub    'No data
    
    Set wsAllowed = Sheets("Allowed Words")
    Set rngAllowed = wsAllowed.Range("A2", wsAllowed.Cells(Rows.Count, "A").End(xlUp))
    If rngAllowed.Row < 2 Then Exit Sub 'No data
    
    rngData.Font.Color = vbBlack
    For Each DataCell In rngData.Cells
        For Each varWord In Split(WorksheetFunction.Trim(DataCell.Text), " ")
            If WorksheetFunction.CountIf(rngAllowed, varWord) = 0 Then DataCell.Characters(InStr(1, DataCell.Text, varWord, vbTextCompare), Len(varWord)).Font.Color = vbRed
        Next varWord
    Next DataCell
    
    Set wsData = Nothing
    Set wsAllowed = Nothing
    Set rngData = Nothing
    Set rngAllowed = Nothing
    Set DataCell = Nothing
    
End Sub

That code will color disallowed words red. You will probably need to adjust rngData to be the actual range you want the code to search through. Does that work for you?

[redfuse]

This is great, thanks so much!

[redfuse]

It works very well, but if you have a little bit more time, I have one more question: is there a way for the macro to ignore punctation marks like , . : ; etc.? Now if there is for instance a comma after a word, it will see that as part of the word and mark it red even if it is one of the allowed words. (e.g. "banana," is marked red) I can add all the possible permutations with different punctuations but maybe there is a simpler way.
But thanks either way!!

[tigeravatar]

Updated code:

Sub tgr()
    
    Dim wsData As Worksheet
    Dim wsAllowed As Worksheet
    Dim rngData As Range
    Dim rngAllowed As Range
    Dim DataCell As Range
    Dim varWord As Variant
    Dim strWord As String
    
    Set wsData = Sheets("Sheet1")
    Set rngData = wsData.Range("A2", wsData.Cells(Rows.Count, "A").End(xlUp))
    If rngData.Row < 2 Then Exit Sub    'No data
    
    Set wsAllowed = Sheets("Allowed Words")
    Set rngAllowed = wsAllowed.Range("A2", wsAllowed.Cells(Rows.Count, "A").End(xlUp))
    If rngAllowed.Row < 2 Then Exit Sub 'No data
    
    rngData.Font.Color = vbBlack
    For Each DataCell In rngData.Cells
        For Each varWord In Split(WorksheetFunction.Trim(DataCell.Text), " ")
            strWord = varWord
            If Not (Asc(UCase(Right(strWord, 1))) > 64 And Asc(UCase(Right(strWord, 1))) < 91) Then strWord = Left(strWord, Len(strWord) - 1)
            If WorksheetFunction.CountIf(rngAllowed, strWord) = 0 Then DataCell.Characters(InStr(1, DataCell.Text, strWord, vbTextCompare), Len(strWord)).Font.Color = vbRed
        Next varWord
    Next DataCell
    
    Set wsData = Nothing
    Set wsAllowed = Nothing
    Set rngData = Nothing
    Set rngAllowed = Nothing
    Set DataCell = Nothing
    
End Sub

[redfuse]

Superb!
Building on your code I added two lines to catch any special characters in front of text, like "(banana", and words that are completely between special characters, like "(banana)"
Not it works perfectly! Thanks again.

[tigeravatar]

You're very welcome

If that takes care of your need, please mark this thread as solved.
How to mark a thread Solved
New quick method:
Select Thread Tools-> Mark thread as Solved. To undo, select Thread Tools-> Mark thread as Unsolved.

Or you can use this way:
Go to the first post
Click edit
Click Go Advanced
Just below the word "Title" you will see a dropdown with the words "No prefix"
Change to "Solved"
Click Save