Code to loop 'Findnext' to find all records that match?

Try this:

Thanks Andrew

Have you tried running the code yourself yet?

It's doing some mad things, some time it runs of with it's self (keeps looping) other times it will just find maybe two out of the 3 records, what do you think I need to change?

The source table is as below

Part__________________Sold_______Date
Bearing Cover_________29________01/01/2003
Rear Case Casting_____28________02/01/2003
Bearing Cover_________20________03/01/2003
Rear Case Casting_____30________04/01/2003
Bearing Cover_________31________05/01/2003




Cheers

Ryan A UK :idea:

I rarely post code I haven't tested. :wink:

With this data (named Table):

ABC 1 11
ABC 2 12
ABC 3 13
ABC 4 14
ABC 5 15
DEF 6 16
DEF 7 17
ABC 8 18
ABC 9 19
ABC 10 20

searching for ABC returned:

ABC 1 11
ABC 2 12
ABC 3 13
ABC 4 14
ABC 5 15
ABC 8 18
ABC 9 19
ABC 10 20

With your data, searching for Bearing returned:

Bearing Cover 29 01/01/2003
Bearing Cover 20 03/01/2003
Bearing Cover 31 05/01/2003

Thanks Andrew you are correct if you run the code from sheet1. Try running it from sheet2, this is when the problems starts. Don’t worry though I've sorted it now! There was another problem as well, if I did a search for DEF then ABC the output list would have about 30 rows gap between each search result. The row count of the used range wasn’t showing the correct figure. Anyway see the below code I've highlighted my changes. I can search from any sheet in the workbook now, it works perfect!

Sub Find()
Dim Na
Dim Rng As Range
Dim F As Range
Dim FirstAddress As String
Dim R As Long
Na = InputBox("Enter Name")
If Na = "" Then Exit Sub
Set Rng = Range("Table")
Set F = Rng.Find(What:=Na, After:=Rng.Cells(Rng.Rows.Count, Rng.Columns.Count))
If Not F Is Nothing Then
FirstAddress = F.Address

If Sheets("Sheet2").Range("A1") <> "" Then
R = Range("Table2").Rows.Count + 1
End If
If Sheets("Sheet2").Range("A1") = "" Then
R = 1
End If
With Sheets("Sheet2").Cells(R, 1)
.Value = F.Value
.Offset(0, 1) = F.Offset(0, 1).Value
.Offset(0, 2) = F.Offset(0, 2).Value
End With
Do
R = R + 1
Set F = Range("Table").FindNext(After:=F)
If F.Address = FirstAddress Then Exit Do
With Sheets("Sheet2").Cells(R, 1)
.Value = F.Value
.Offset(0, 1) = F.Offset(0, 1).Value
.Offset(0, 2) = F.Offset(0, 2).Value
End With
Loop
Else
MsgBox ("Not found")
End If
End Sub
Many Thanks again Andrew, you always come up trumps, you’re a genius!

Do you think it could be tailored more to search for two different criteria? Let’s say we added another column to the source table called ‘Invoiced’, the records under this would be ‘TRUE’ or ‘FALSE’. Records found for ‘ABC’ with ‘FALSE would be sent to the destination table.

Thanks Again :D

Ryan A UK :P

Do you think it could be tailored more to search for two different criteria? Let’s say we added another column to the source table called ‘Invoiced’, the records under this would be ‘TRUE’ or ‘FALSE’. Records found for ‘ABC’ with ‘FALSE would be sent to the destination table.

Click to expand...

Andrew check this out! I've managed to do it thanks to your help!!

Sub Find()
Dim Na
Dim Rng As Range
Dim F As Range
Dim FirstAddress As String
Dim R As Long

Na = InputBox("Enter Name")
If Na = "" Then Exit Sub
Set Rng = Range("Table")
Set F = Rng.Find(What:=Na, After:=Rng.Cells(Rng.Rows.Count, 1), _
LookIn:=xlValues, lookat:=xlWhole)

If Not F Is Nothing Then
FirstAddress = F.Address

If Sheets("Sheet2").Range("A1") <> "" Then
R = Range("Table2").Rows.Count + 1
End If
If Sheets("Sheet2").Range("A1") = "" Then
R = 1
End If

If F.Offset(0, 3) = False Then
With Sheets("Sheet2").Cells(R, 1)
.Value = F.Value
.Offset(0, 1) = F.Offset(0, 1).Value
.Offset(0, 2) = F.Offset(0, 2).Value

End With
Else
If Sheets("Sheet2").Range("A1") <> "" Then
R = Range("Table2").Rows.Count
Else
R = 0
End If
End If
Do
Set F = Range("Table").FindNext(After:=F)
If F.Address = FirstAddress Then Exit Do

If F.Offset(0, 3) = False Then
R = R + 1
With Sheets("Sheet2").Cells(R, 1)
.Value = F.Value
.Offset(0, 1) = F.Offset(0, 1).Value
.Offset(0, 2) = F.Offset(0, 2).Value
End With
End If
Loop
Else
MsgBox ("Not found")
End If
End Sub


Thanks for all your help

Ryan A UK :P