Using Find as lookup method goes to semi endless loop

[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.

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

 

[Claus Busch]

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.

 

[Walter Briscoe]

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 <[email protected]> of
Sat, 21 Jun 2014 23:09:42 in microsoft.public.excel.programming, L.

 

[Claus Busch]

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.

 

[Claus Busch]

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.

 

[Claus Busch]

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.

 

[L. Howard]

Hi Howard,



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






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

 

[L. Howard]

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



Howard

I'm using Sub MyBadFoodFind3() which works the way I want it to and bring up the question about UsedRange.

I just so happened I had dispersed some sample test strings on the sheet all of which are with in the range od D4:H22.

That leaves three columns and five rows with no data and the code ignores the test data inside range D4:H22.

If I fill row 1 over to column H and column A down to row 22 the code works perfectly, with the nice touch of a message box with what was not found.

So with no data in row 1 or column A, LRow and LCol both = 1 and the test data is ignored.

With arrCheck = .UsedRange seems it would consider everything to the last used column and row where ctrl + end would take me and that is cell J22.

Howard

 

[L. Howard]

Hi Howard,



Am Sun, 22 Jun 2014 03:53:03 -0700 (PDT) schrieb L. Howard:






then set your range and the start cell explicit:

Thar works fine.
You are a champion! Nice and thanks.

Regards,
Howard

 

[Claus Busch]

Hi Howard,

Am Sun, 22 Jun 2014 04:27:39 -0700 (PDT) schrieb L. Howard:

Thar works fine.

to make the code a bit more universal you can also work with UsedRange:

Sub MyBadFoodFind4()

Dim i As Long, j As Long, n As Long
Dim MyArr As Variant, arrCheck As Variant, arrRng As Variant
Dim LRow As Long, LCol As Long
Dim iRet As Integer
Dim strPrompt As String, strRng As String
Dim strTitle As String, myStr As String
Dim StartC As Range
Dim OffRow As Long, OffCol As Long

With Sheets("Sheet1")
.UsedRange.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")

strRng = .UsedRange.Address(0, 0)
arrRng = Split(strRng, ":")
Set StartC = .Range(arrRng(0))
OffRow = StartC.Row - 1
OffCol = StartC.Column - 1

arrCheck = .UsedRange
LCol = .UsedRange.Columns.Count
LRow = .UsedRange.Rows.Count

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 + OffRow, n +
OffCol).Interior.ColorIndex = 6
End If
Next n
Next i
End If
NextLoop:
Next j
End With

Application.ScreenUpdating = True
If Len(myStr) > 0 Then
MsgBox "No matches found for:" & Chr(10) & myStr
End If

End Sub


Regards
Claus B.

 

[L. Howard]

Hi Howard,



Am Sun, 22 Jun 2014 04:27:39 -0700 (PDT) schrieb L. Howard:






to make the code a bit more universal you can also work with UsedRange:


Regards

Claus B.

--

Great, now one can either set the 'search' area to exclude certain cells using code ...3() or go with UsedRange for all cells using code ...4().

Thanks again Claus.

Regards,
Howard