find an array, only finds first entry

[John]

I am trying to find 3 values and my code only finds the first one and quits...

any thoughts?

Sub OTRhighlight()
'
' OTRhighlight Macro
' Macro recorded 8/10/2006 by johnd
'

'

On Error GoTo ErrorHandler
Dim rngToSearch As Range
Dim wks1 As Worksheet

Dim rngFound As Range
'Dim rngAllFound As Range
'Dim rngFirst As Range
'Dim rngDestination As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
num1 = Sheets("Data").Range("G1")
num2 = Sheets("Data").Range("G2")
num3 = Sheets("Data").Range("G3")

Set wks1 = Sheets("Matrix")
wks1.Select
counter = 0


Set rngToSearch = wks1.Range("a10:a38")
rngToSearch.Font.Bold = False
rngToSearch.Font.ColorIndex = 1
Set rngFound = rngToSearch.Find(Array(num1, num2, num3), LookIn:=xlValues)
If rngFound Is Nothing Then
MsgBox "Nothing found"
Else
'Set rngFirst = rngFound
'MsgBox "hi"
Do
rngFound.Font.ColorIndex = 11
rngFound.Font.Bold = True
counter = counter + 1
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngfirst.Address
End If

wks1.Range("A7").Select

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Jim Thomlinson]

You must do each element of the array seperately... something like this...

On Error GoTo ErrorHandler
Dim rngToSearch As Range
Dim wks1 As Worksheet

Dim rngFound As Range
Dim rng As Range
'Dim rngAllFound As Range
'Dim rngFirst As Range
'Dim rngDestination As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'num1 = Sheets("Data").Range("G1")
'num2 = Sheets("Data").Range("G2")
'num3 = Sheets("Data").Range("G3")

Set wks1 = Sheets("Matrix")
wks1.Select
counter = 0

Set rngToSearch = wks1.Range("a10:a38")
rngToSearch.Font.Bold = False
rngToSearch.Font.ColorIndex = 1
for each rng in Sheets("Data").Range("G1:G3")
Set rngFound = rngToSearch.Find(rng.value, LookIn:=xlValues)
If rngFound Is Nothing Then
MsgBox rng.value & " Nothing found"
Else
Set rngFirst = rngFound
'MsgBox "hi"
Do
rngFound.Font.ColorIndex = 11
rngFound.Font.Bold = True
counter = counter + 1
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngfirst.Address
End If
next rng
wks1.Range("A7").Select

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[John]

thanks Jim, works great

You must do each element of the array seperately... something like this...

On Error GoTo ErrorHandler
Dim rngToSearch As Range
Dim wks1 As Worksheet

Dim rngFound As Range
Dim rng As Range
'Dim rngAllFound As Range
'Dim rngFirst As Range
'Dim rngDestination As Range

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'num1 = Sheets("Data").Range("G1")
'num2 = Sheets("Data").Range("G2")
'num3 = Sheets("Data").Range("G3")

Set wks1 = Sheets("Matrix")
wks1.Select
counter = 0

Set rngToSearch = wks1.Range("a10:a38")
rngToSearch.Font.Bold = False
rngToSearch.Font.ColorIndex = 1
for each rng in Sheets("Data").Range("G1:G3")
Set rngFound = rngToSearch.Find(rng.value, LookIn:=xlValues)
If rngFound Is Nothing Then
MsgBox rng.value & " Nothing found"
Else
Set rngFirst = rngFound
'MsgBox "hi"
Do
rngFound.Font.ColorIndex = 11
rngFound.Font.Bold = True
counter = counter + 1
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngfirst.Address
End If
next rng
wks1.Range("A7").Select

ErrorHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Gary Keramidas]

i used something like this, it may work for you. posting just as another idea.

in my application, this arr can have up to 40 elements. i create it on the fly
and then this code runs and deletes a row based on the element value


For z = LBound(arr) To UBound(arr)

Set rng = .Cells.Find(What:=arr(z), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Debug.Print rng
rng.EntireRow.Delete
Next z

 

[John]

interesting

i used something like this, it may work for you. posting just as another idea.

in my application, this arr can have up to 40 elements. i create it on the fly
and then this code runs and deletes a row based on the element value


For z = LBound(arr) To UBound(arr)

Set rng = .Cells.Find(What:=arr(z), _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
Debug.Print rng
rng.EntireRow.Delete
Next z