Return error or message if a randomly created text contains a word that is contained on a separate a list

[robbo2830]

I have to create a random 11 character string containing letters and numbers, which will be used to create a barcode that will be printed on an envelope. As the barcode text will also be printed it must not contain any profanities.
I have 2 tabs on my spreadsheet, tab one contains the randomly created barcode text. Tab two contains the list of profanities.
What I want to do is check if any of my barcodes contain any of the words that are on the list of profanities, and ideally return an error, or message of some sort.

The best I can do is find a specific word and return an error, which works. See below:

Dim i As Integer, intValueToFind As Integer
intValueToFind = anus
For i = 1 To 1500 ' Revise the 1500 to include all of your values
If Cells(i, 1).Value = intValueToFind Then
MsgBox ("Found value on row " & i)
Exit Sub
End If
Next i

' This MsgBox will only show if the loop completes with no success
MsgBox ("Value not found in the range!")
End Sub


What I want to change is this line:
intValueToFind = anus

So instead of looking for one word, it looks through all the words (1500 in total) in my second tab and returns an error if it sees any of them. The range I am searching in is:
=PROFANITY!A1:A1500

Many thanks in advance

 

[DanteAmor]

Hi and welcome to MrExcel.

Try this:

Sub test()
  Dim a As Variant, b As Variant, c As Variant
  Dim sh1 As Worksheet
  Dim i As Long, j As Long
  '
  'tab name with randomly barcode text
  Set sh1 = Sheets("Sheet1")
  '
  a = sh1.Range("A1", sh1.Range("A" & Rows.Count).End(3)).Value
  b = Sheets("PROFANITY").Range("A1", Sheets("PROFANITY").Range("A" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(a, 1), 1 To 1)
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(b, 1)
      If InStr(1, a(i, 1), b(j, 1), vbTextCompare) > 0 Then
        c(i, 1) = b(j, 1)
        Exit For
      End If
    Next j
  Next i
  '
  'Output in column C
  sh1.Range("C1").Resize(UBound(a, 1)).Value = c
End Sub

 

[robbo2830]

Hi and welcome to MrExcel.

Try this:

Sub test()
  Dim a As Variant, b As Variant, c As Variant
  Dim sh1 As Worksheet
  Dim i As Long, j As Long
  '
  'tab name with randomly barcode text
  Set sh1 = Sheets("Sheet1")
  '
  a = sh1.Range("A1", sh1.Range("A" & Rows.Count).End(3)).Value
  b = Sheets("PROFANITY").Range("A1", Sheets("PROFANITY").Range("A" & Rows.Count).End(3)).Value
  ReDim c(1 To UBound(a, 1), 1 To 1)
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(b, 1)
      If InStr(1, a(i, 1), b(j, 1), vbTextCompare) > 0 Then
        c(i, 1) = b(j, 1)
        Exit For
      End If
    Next j
  Next i
  '
  'Output in column C
  sh1.Range("C1").Resize(UBound(a, 1)).Value = c
End Sub

Thank you very much

 

[DanteAmor]

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