Find...FindNext Problem
Hi,
1. I have made this general FindAll function bellow which uses the Find and
FindNext.
2. What you can do:
- search for SS only. Result range is rg1
- search for 2001 only. result range ios rg2
- finalRange = application.intersect(rg1,rg2.Offset(0,-1))
3. That would be:
Dim colRg as Range, Rg1 as range, Rg2 as range, Rg as Range
...
'search for SS
Set colRg = PAVTAry.Columns(1) 'column to be searched for SS isn't it
Set Rg1 = FindAll("SS",colRg,xlValues,xlwhole)
'search for 2001
Set colRg = PAVTAry.Columns(2) 'column to be searched for 2001 isn't it
Set Rg2 = FindAll(2001,colRg,xlValues,xlwhole)
'Intersection
If rg1 is nothing or rg2 is nothing then
set rg = nothing
else
set rg=application.intersect(rg1,rg2.offset(0,-1))
end if
'Display Result
if rg is nothing then
msgbox "No cell found"
else
msgbox rg.address
end if
'-----------------------------------------------------------------
Function FindAll(What As Variant, _
Where As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False, _
Optional MatchByte As Boolean = False _
) As Range
Dim ResultRg As Range
Dim Rg As Range
Dim firstAddress As String
With Where
Set Rg = .Find(What, LookIn:=LookIn, LookAt:=LookAt,
MatchCase:=MatchCase, MatchByte:=MatchByte)
If Not Rg Is Nothing Then
Set ResultRg = Rg
firstAddress = Rg.Address
Do
Set ResultRg = Application.Union(ResultRg, Rg)
Set Rg = .FindNext(Rg)
Loop While Not Rg Is Nothing And Rg.Address < firstAddress
End If
End With
Set FindAll = ResultRg
End Functio
'-------------------------------------------------------------------------------
|