Loop a find command across multiple rows and worksheets

[jonnycantprogram]

Hey guys, I'm a bit new to this but am starting to get the hang of it but could use some help. I have a large data file with several different worksheets. In one cell I have a large set of individual numbers (i.e in the cell there is "123456 234234 939829") This value is my 'sample' number. The same sample could be in multiple rows on one sheet and could also be on other sheets. I am trying to find the sample in a column (on some sheets its column "Q", other sheets it could be different columns, but that column is fixed per sheet) and then copy the information on the same row in columns A & B and copy it to my target sheet. Then the next place the sample appears copy that info to the next row of my target sheet. So far I am stuck getting it to find the multiple values on one sheet. My code is below. I hope I have put everything in the right format for you. First time using the forums. Any and all help is greatly appreciated.

Sub Samplesearch()
    
    Dim sample          As String
    Dim x               As Integer
    Dim y               As Integer
    Dim lr              As Long
    Dim lsr             As Long
    
    
'clear sample lookup sheet
    Worksheets("Sample Lookup").Activate
    Range("A:B").ClearContents
    
'Prompt Sample Lookup
    sample = InputBox("What sample are you looking for?", "Sample Search")
        If sample = "" Then
            GoTo EndLookup
        End If
        
        
        lr = Sheets("Urine").Range("A" & Rows.Count).End(xlUp).Row            
                
                    Sheets("Urine").Activate
                    With Cells
                      
                        .Find(sample).Select
                        
                        ActiveCell.Offset(0, -16).Copy
                        
                        Sheets("Sample Lookup").Activate
                        
                        lsr = Sheets("Sample Lookup").Range("A" & Rows.Count).End(xlUp).Row
                        Cells(lsr, 1).PasteSpecial
                        Sheets("Urine").Select
                        ActiveCell.Offset(0, -15).Copy
                        Sheets("Sample Lookup").Activate
                        
                        Cells(lsr, 2).PasteSpecial
                    
                        Do
                            .FindNext.Select
                            ActiveCell.Offset(0, -16).Copy
                            Sheets("Sample Lookup").Activate
                            lsr = Sheets("Sample Lookup").Range("A" & Rows.Count).End(xlUp).Row
                            Cells(lsr, 1).PasteSpecial
                            Sheets("Urine").Select
                            ActiveCell.Offset(0, -15).Copy
                            Sheets("Sample Lookup").Activate
                        Loop
                        
                    End With
                    
                
                
            
'        Next y
        
                        
            
          
            
          
          
    
 
EndLookup:
End Sub

 

[AlphaFrog]

Hi and welcome to the forum

Try this...

[COLOR=darkblue]Sub[/COLOR] Samplesearch()
    
    [COLOR=darkblue]Dim[/COLOR] sample     [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ws         [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] wsDest     [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Found      [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] FirstFound [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] counter    [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'Prompt Sample Lookup[/COLOR]
    sample = Application.InputBox("What sample are you looking for?", "Sample Search", Type:=2)
    [COLOR=darkblue]If[/COLOR] sample = "False" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]    [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=green]'clear sample lookup sheet[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wsDest = Worksheets("Sample Lookup")
    wsDest.Range("A:B").ClearContents
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Worksheets
        
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] ws [COLOR=darkblue]Is[/COLOR] wsDest [COLOR=darkblue]Then[/COLOR]
            
            [COLOR=darkblue]Set[/COLOR] Found = ws.Cells.Find(sample, , xlValues, xlWhole, xlByRows, xlNext, [COLOR=darkblue]False[/COLOR])
            
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
                
                FirstFound = Found.Address
                
                [COLOR=darkblue]Do[/COLOR]
                    Found.EntireRow.Range("A1:B1").Copy _
                        Destination:=wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
                    counter = counter + 1
                    [COLOR=darkblue]Set[/COLOR] Found = ws.Cells.FindNext(After:=Found)
    
                [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] Found.Address = FirstFound
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] ws
    
    Application.Goto wsDest.Range("A1")
    
    MsgBox counter & " matches copied. ", vbInformation, "Search Complete"
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

You might find this link helpful
The Find Method

 

[jonnycantprogram]

Hi and welcome to the forum

Try this...

[COLOR=darkblue]Sub[/COLOR] Samplesearch()
    
    [COLOR=darkblue]Dim[/COLOR] sample     [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] ws         [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] wsDest     [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Found      [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] FirstFound [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] counter    [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=green]'Prompt Sample Lookup[/COLOR]
    sample = Application.InputBox("What sample are you looking for?", "Sample Search", Type:=2)
    [COLOR=darkblue]If[/COLOR] sample = "False" [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]    [COLOR=green]'User canceled[/COLOR]
    
    [COLOR=green]'clear sample lookup sheet[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wsDest = Worksheets("Sample Lookup")
    wsDest.Range("A:B").ClearContents
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] ws [COLOR=darkblue]In[/COLOR] Worksheets
        
        [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] ws [COLOR=darkblue]Is[/COLOR] wsDest [COLOR=darkblue]Then[/COLOR]
            
            [COLOR=darkblue]Set[/COLOR] Found = ws.Cells.Find(sample, , xlValues, xlWhole, xlByRows, xlNext, [COLOR=darkblue]False[/COLOR])
            
            [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Found [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
                
                FirstFound = Found.Address
                
                [COLOR=darkblue]Do[/COLOR]
                    Found.EntireRow.Range("A1:B1").Copy _
                        Destination:=wsDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
                    counter = counter + 1
                    [COLOR=darkblue]Set[/COLOR] Found = ws.Cells.FindNext(After:=Found)
    
                [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]Until[/COLOR] Found.Address = FirstFound
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] ws
    
    Application.Goto wsDest.Range("A1")
    
    MsgBox counter & " matches copied. ", vbInformation, "Search Complete"
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

You might find this link helpful
The Find Method

Thanks Mr. Frog, This looks really good and I feel like its close based off reading that link you sent me. That being said, the variable for found stays equal to nothing throughout my walkthrough. Do I Need to specify my worksheets in an array to make this work? I'm not sure how to go about this I did attempt changing the code to

Set Found = Sheets("Urine").Cells.Find(sample, , xlValues, xlWhole, xlByRows, xlNext, False)

hoping that I would find something on the Urine sheet but still found nothing.

 

[AlphaFrog]

Thanks Mr. Frog, This looks really good and I feel like its close based off reading that link you sent me. That being said, the variable for found stays equal to nothing throughout my walkthrough. Do I Need to specify my worksheets in an array to make this work? I'm not sure how to go about this I did attempt changing the code to

Set Found = Sheets("Urine").Cells.Find(sample, , xlValues, xlWhole, xlByRows, xlNext, False)

hoping that I would find something on the Urine sheet but still found nothing.

It's not a worksheet array issue. The code loops trough all the sheets and ignores searching just the Destination sheet. I tested the code on made-up data and it worked for me.

The .Find method is not fining a match. The issue is most likely with .Find method argument settings, or your Search string and data is not an exact match (not starts-with, ends-with, or contains) for some reason. It's looking for an exact match including spaces and Alpha-Numeric characters.

The data sheets and the Destination sheet are in the same workbook; correct?

 

[jonnycantprogram]

It's not a worksheet array issue. The code loops trough all the sheets and ignores searching just the Destination sheet. I tested the code on made-up data and it worked for me.

The .Find method is not fining a match. The issue is most likely with .Find method argument settings, or your Search string and data is not an exact match (not starts-with, ends-with, or contains) for some reason. It's looking for an exact match including spaces and Alpha-Numeric characters.

The data sheets and the Destination sheet are in the same workbook; correct?

Yes they are in the same workbook. For the particular example I was using on my test page the search needed to look for part so I changed from xlwhole to xlpart and that fixed it. Thank you so much for your help. This has solved a big part of my problems... for now. Haha Again, Thanks a ton.

 

[AlphaFrog]

Well done and you're welcome.