I wrote code to find these array elements if they are single strings in a cell and highlights them. It works well.

I am trying to adjust that code to highlight the elements if they are used in a sentence... "I like beer." or just 'beer' alone then it would be highlighted.

This code comes up "No match found." and I have to hold esc key for about 500? iterations then the first occurance only of any found elements are highlighted.

I'm thinking xlPart may be a problem also, but havn't got that far with the code yet.

Thanks.
Howard

Sub MyBadFoodFind()

Dim i As Long
Dim MyArr As Variant
Dim c As Range

Sheets("Sheet1").Cells.Interior.ColorIndex = xlNone

Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = " Highlights have been removed." & vbCr & _
"If you want to continue click ""Yes."""

strTitle = "My Bad Eats"

iRet = MsgBox(strPrompt, vbYesNo, strTitle)

If iRet = vbNo Then
Exit Sub
Else
'
End If

MyArr = Array("milk", "soda", "fries", "pizza", "beer", "chips", _
"candy", "alcohol", "mcdonalds", "wendys", "burger king")

Application.ScreenUpdating = False

For Each c In Sheets("Sheet1").UsedRange
For i = LBound(MyArr) To UBound(MyArr)

Set c = Sheets("Sheet1").UsedRange.Find(What:=MyArr(i), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not c Is Nothing Then
c.Interior.ColorIndex = 6
Else
MsgBox "No match found."
End If

Next 'i
Next 'c

Application.ScreenUpdating = True
End Sub

Hi Howard,

Am Sat, 21 Jun 2014 23:09:42 -0700 (PDT) schrieb L. Howard:

I wrote code to find these array elements if they are single strings in a cell and highlights them. It works well.

I am trying to adjust that code to highlight the elements if they are used in a sentence... "I like beer." or just 'beer' alone then it would be highlighted.

the code would be faster if you read the used range into an array.

Try:

Sub MyBadFoodFind2()

Dim i As Long, j As Long, n As Long
Dim MyArr As Variant, arrCheck As Variant
Dim LRow As Long, LCol As Long

Sheets("Sheet1").Cells.Interior.ColorIndex = xlNone

Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = " Highlights have been removed." & vbCr & _
"If you want to continue click ""Yes."""

strTitle = "My Bad Eats"

iRet = MsgBox(strPrompt, vbYesNo, strTitle)

If iRet = vbNo Then
Exit Sub
Else
'
End If

MyArr = Array("milk", "soda", "fries", "pizza", "beer", "chips", _
"candy", "alcohol", "mcdonalds", "wendys", "burger king")

arrCheck = Sheets("Sheet1").UsedRange
LCol = Sheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
LRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For i = 1 To LRow
For n = 1 To LCol
For j = LBound(MyArr) To UBound(MyArr)
If InStr(arrCheck(i, n), MyArr(j)) Then
Cells(i, n).Interior.ColorIndex = 6
End If
Next
Next
Next

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi again,

Am Sun, 22 Jun 2014 09:18:45 +0200 schrieb Claus Busch:

If InStr(arrCheck(i, n), MyArr(j)) Then

change the line above to:

If InStr(LCase(arrCheck(i, n)), MyArr(j)) Then


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Sun, 22 Jun 2014 09:22:59 +0200 schrieb Claus Busch:

If InStr(LCase(arrCheck(i, n)), MyArr(j)) Then

if you want a MsgBox if there are no matches then try:

Sub MyBadFoodFind3()

Dim i As Long, j As Long, n As Long
Dim MyArr As Variant, arrCheck As Variant
Dim LRow As Long, LCol As Long
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String, myStr As String

With Sheets("Sheet1")
.Cells.Interior.ColorIndex = xlNone

strPrompt = " Highlights have been removed." & vbCr & _
"If you want to continue click ""Yes."""

strTitle = "My Bad Eats"

iRet = MsgBox(strPrompt, vbYesNo, strTitle)

If iRet = vbNo Then
Exit Sub
Else
'
End If

MyArr = Array("milk", "soda", "fries", "pizza", "beer", "chips", _
"candy", "alcohol", "mcdonalds", "wendys", "burger king")

arrCheck = .UsedRange
LCol = .Cells(1, Columns.Count).End(xlToLeft).Column
LRow = .Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False

For j = LBound(MyArr) To UBound(MyArr)
If WorksheetFunction.CountIf(.UsedRange, "*" & MyArr(j) & "*") =
0 Then
myStr = myStr & MyArr(j) & Chr(10)
GoTo NextLoop
Else
For i = 1 To LRow
For n = 1 To LCol
If InStr(LCase(arrCheck(i, n)), MyArr(j)) Then
.Cells(i, n).Interior.ColorIndex = 6
End If
Next n
Next i
End If
NextLoop:
Next j
End With

Application.ScreenUpdating = True
MsgBox "No matches found for:" & Chr(10) & myStr

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Howard,

Am Sun, 22 Jun 2014 10:10:28 +0200 schrieb Claus Busch:

MsgBox "No matches found for:" & Chr(10) & myStr

change the line above to:

If Len(myStr) 0 Then
MsgBox "No matches found for:" & Chr(10) & myStr
End If


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Sunday, June 22, 2014 1:45:32 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sun, 22 Jun 2014 10:10:28 +0200 schrieb Claus Busch:



MsgBox "No matches found for:" & Chr(10) & myStr



change the line above to:



If Len(myStr) 0 Then

MsgBox "No matches found for:" & Chr(10) & myStr

End If





Regards

Claus B.

--

Thanks Claus, I'll put together with the changes and give it a go.

Howard

Have you neglected to use findnext?
cf 2003 help:

....
Example
This example finds all cells in the range A1:A500 on worksheet one that
contain the value 2 and changes it to 5.

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With


In message of
Sat, 21 Jun 2014 23:09:42 in microsoft.public.excel.programming, L.
Howard writes
I wrote code to find these array elements if they are single strings in
a cell and highlights them. It works well.

I am trying to adjust that code to highlight the elements if they are
used in a sentence... "I like beer." or just 'beer' alone then it
would be highlighted.

This code comes up "No match found." and I have to hold esc key for
about 500? iterations then the first occurance only of any found
elements are highlighted.

I'm thinking xlPart may be a problem also, but havn't got that far with
the code yet.

Thanks.
Howard

Sub MyBadFoodFind()

Dim i As Long
Dim MyArr As Variant
Dim c As Range

Sheets("Sheet1").Cells.Interior.ColorIndex = xlNone

Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

strPrompt = " Highlights have been removed." & vbCr & _
"If you want to continue click ""Yes."""

strTitle = "My Bad Eats"

iRet = MsgBox(strPrompt, vbYesNo, strTitle)

If iRet = vbNo Then
Exit Sub
Else
'
End If

MyArr = Array("milk", "soda", "fries", "pizza", "beer", "chips", _
"candy", "alcohol", "mcdonalds", "wendys", "burger king")

Application.ScreenUpdating = False

For Each c In Sheets("Sheet1").UsedRange
For i = LBound(MyArr) To UBound(MyArr)

Set c = Sheets("Sheet1").UsedRange.Find(What:=MyArr(i), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not c Is Nothing Then
c.Interior.ColorIndex = 6
Else
MsgBox "No match found."
End If

Next 'i
Next 'c

Application.ScreenUpdating = True
End Sub

--
Walter Briscoe