find an array, only finds first entry

J

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
 
J

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
 
J

John

thanks Jim, works great

Jim Thomlinson said:
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
 
G

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
 
J

John

interesting

Gary Keramidas said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

vb code help with date format 2
VB Code help 1
VB code help please 2
Copy/paste error help 4
find multiple values code tweak 5
Delete rows macro 3
Cut instead of Copy 7
loop with array 6

Top