Find...FindNext Problem

[mtsark]

I am attempting to transfer scoring data (based upon two criteria) from one
worksheet to another using VBA Find and FindNext. The problem I'm having is
the Find Method only returns the first Run value. I'm fairly sure the
problem is how I'm using FindNext. I've tried some different combinations
but I can't seem to get it right.

Any help would be greatly appreciated!

Sample Source Worksheet:
Position Year Name Runs
1B 2000 Player1 2
SS 2001 Player2 10
SS 2001 Player3 4
C 2002 Player4 28

the code below only returns the value of 10:

Dim PAVTAry As Range, SrcChk1 As Range
Dim FirstAddress As String
Lr = LastRow(Sheets("3-yr Scoring")) + 1
Set PAVTAry = Sheets("3-yr Scoring").Range("A3:AH" & Lr)
Sheets("PAVT Data").Range("F2").Select
Do
Set SrcChk1 = PAVTAry.Find(What:="SS", LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)
If Not SrcChk1 Is Nothing Then
FirstAddress = SrcChk1.Address
Do
Set SrcChk1 = PAVTAry.FindNext(SrcChk1)
If SrcChk1.Offset(0, 1).Value = 2001 Then
ActiveCell.Value = SrcChk1.Offset(0, 2).Value
End If
Loop While Not SrcChk1 Is Nothing And SrcChk1.Address <>
FirstAddress
Else
ActiveCell.Value = "0"
End If
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -5))

 

[sebastienm]

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
'-------------------------------------------------------------------------------

 

[mtsark]

Thanks sebastienm that worked great but I need to return the value from the
Runs column for each record shown. I attempted to substitute the following
code where you displayed the finalRange but it only returned the Run total
from the first record found:

For Each Rng In Rg
ActiveCell.Value = Rg.Offset(0, 33).Value
ActiveCell.Offset(1, 0).Select
Next Rng

Destination Worksheet (using previous example)
my modifcation generates:
Position Runs
SS1 10
SS2 10
SS3 10
.... ...

I would like it to return
Position Runs
SS1 10
SS2 4
SS3 23
.... ...

Another question, for this function to work properly does the source data
need to already be sorted? This may not always be the case, but it is easy
enough for me to add that code to the macro.

 

[sebastienm]

mtsark,
I believe it is because you use rg instead of Rng in:
Rg.Offset(0, 33).Value
No it shouldn't be necessary. Have you found weird results that make you
think so?

Regards,
Sebastien

 

[sebastienm]

You're welcome. Glad it helped.
And thanks for marking my responses as 'an answer'. It makes searches more
efficient and rewards the answerer.

Sebastien.