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

razzandy

Active Member
Joined
Jun 26, 2002
Messages
400
Office Version
  1. 2007
Platform
  1. Windows
Below is my code, I've stretched my brain to its limit on this so I'm wandering if any one can help me out?

I'm using the ‘find’ and ‘findnext’ function to locate a record from a table then list the row on another sheet. My code only finds two records, so I need some sort of loop which keeps searching until all matching records are found!

Sub Find()
Dim R
Dim F
Dim Na
Dim F2

Na = InputBox("Enter Name")
On Error GoTo 1
F = Range("Table").Find(Na).Address
F2 = Range("Table").FindNext(After:=Range(F)).Address
R = Sheets("Sheet2").UsedRange.Rows.Count + 1
If Sheets("Sheet2").Range("A1") = "" Then
R = 1
End If
With Sheets("Sheet2").Cells(R, 1)
.Value = Sheets("Sheet1").Range(F)
.Offset(0, 1) = Sheets("Sheet1").Range(F).Offset(0, 1)
.Offset(0, 2) = Sheets("Sheet1").Range(F).Offset(0, 2)
End With

If F2 > F Then
With Sheets("Sheet2").Cells(R, 1)
.Offset(1, 0) = Range("Table").FindNext(After:=Range(F))
.Offset(1, 1) = Range("Table").FindNext(After:=Range(F)).Offset(0, 1)
.Offset(1, 2) = Range("Table").FindNext(After:=Range(F)).Offset(0, 2)
End With

End If
Exit Sub
1
MsgBox ("Not found")


End Sub

Thanks in advance :D

Ryan A UK :roll:
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Try this:

Code:
Sub Test()
    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
        R = Sheets("Sheet2").UsedRange.Rows.Count + 1
        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 = Cells.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
 
Upvote 0
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? :oops:

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:
 
Upvote 0
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
 
Upvote 0
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. :roll:

Thanks Again :D

Ryan A UK :P
 
Upvote 0
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.

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

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
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top