Thread: muliple searches and loops

there is a piece of code called GeneFinder() and it works perfectly for finding one instance of the "gene names in sheet1" from the list in sheet3. However, if there is more than one instance of the gene names in sheet1 it will only find the first one and then move on to the next term from sheet3. I was wondering if there was anyway to do a "findAll" sort of function for the items in sheet3?

Sub GeneFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
'Clear Sheet 2 and Copy Column Headings
 Sheets(2).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
   srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column D, copy it top the next row in Sheet2
  With Sheets(1).Columns("D")
    For gName = 2 To srchLen
      Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlPart)
        If Not g Is Nothing Then
          nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
          g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
        End If
    Next
  End With
End Sub

i'm not great with loops, and need to identify where to apply the loop to find more than the 1 instance of the name from sheet 3.

help would be gratefully recieved!

Give this a try. Since i am unable to see your workbook this may or may not do what you want.

Option Explicit

Sub GeneFinder()
Dim srchLen, gName, nxtRw As Integer
Dim g As Range
Dim startaddress As Variant

Application.ScreeUpdating = False
'Clear Sheet 2 and Copy Column Headings
 Sheets(2).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
   srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column D, copy it top the next row in Sheet2
  With Sheets(1).Columns("D")
    For gName = 2 To srchLen
      Set g = .Find(Sheets(3).Range("A" & gName), lookat:=xlPart)
        If Not g Is Nothing Then
          nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
          g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
        End If
      startaddress = g.Address
        Do
          If Not g Is Nothing Then
            nxtRw = Sheets(2).Range("D" & Rows.Count).End(xlUp).Row + 1
            g.EntireRow.Copy Destination:=Sheets(2).Range("A" & nxtRw)
          End If
          Set g = .FindNext(g)
        Loop While Not g Is Nothing And g.Address <> startaddress
        Application.ScreenUpdating = True
    Next
  End With
End Sub

Here you go: I made some adjustments to shorten/clean up the code

Option Explicit

Sub GeneFinder()
Dim srchLen As Long, gName As Long, lastrow As Long
Dim g As Range
Dim startaddress As Variant

Application.ScreenUpdating = False
'Clear Sheet 2 and Copy Column Headings
 Sheets(2).Cells.ClearContents
 Sheets(1).Rows(1).Copy Destination:=Sheets(2).Rows(1)
'Determine length of Search Column from Sheet3
   srchLen = Sheets(3).Range("A" & Rows.Count).End(xlUp).Row
   lastrow = Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
'Loop through list in Sheet3, Column A. As each value is
'found in Sheet1, Column D, copy it top the next row in Sheet2
    For gName = 2 To srchLen
      Set g = Sheets(1).Range("D2:D" & lastrow).Find(Sheets(3).Range("A" & gName), lookat:=xlPart)
        If Not g Is Nothing Then
          startaddress = g.Address
        Do
          g.EntireRow.Copy Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
          Set g = Sheets(1).Range("D2:D" & lastrow).FindNext(g)
        Loop While Not g Is Nothing And g.Address <> startaddress
        End If
    Next
Application.ScreenUpdating = True

End Sub

stnkynts - thank you very much for taking the time to refine the code.

i really appreciate it!