Results 1 to 5 of 5

Put Find code in Loop to find all matches

Threaded View

  1. #1
    Forum Contributor
    Join Date
    12-02-2009
    Location
    Australia
    MS-Off Ver
    Excel 2003
    Posts
    209

    Put Find code in Loop to find all matches

    hi guys,

    Is there a way to put the below in a loop so that it finds all of the matches, not just a single match then move onto the next Ccell.

    At the moment it is finding 'Sarah' (for example) and then copying the line then moving to 'Forum' when in fact there are multiple 'Sarah's, and I wanted all the Sarah's to be copied then for it to look for the next in the list (Forum).

    as a side note it would really really be appreciated if you can educate\talk me through the looping code that you come up with as I would love nothing more than learn in all honestly.

    Thanks a lot in advance,

    FYI: the below code works atm , just not how i would like it.

    
    'this sub will find all the members in all the groups for your selected application.
    Sub findandmake()
    
    Dim Ws1 As Worksheet 'Search
    Dim SearchRng As Range
    Dim Ws3 As Worksheet 'Approver Members
    Dim FindRng3 As Range
    Dim Ws4 As Worksheet 'Output
    
    Dim CopyRng As Range 'Set when Found
    Dim PasteRng As Range 'keeps the latest row
    
    Set Ws1 = Worksheets("Groups to find")
    Set SearchRng = Ws1.Range("A1:A" & Ws1.Cells(Ws1.Cells.Rows.Count, 1).End(xlUp).Row)
    
    Set Ws3 = Worksheets("Approver Members")
    Set FindRng3 = Ws3.Range("A3:A" & Ws3.Cells(Ws3.Cells.Rows.Count, 4).End(xlUp).Row)
    
    Set Ws4 = Worksheets("Approver group members")
    Set PasteRng = Ws4.Cells(1, 1)
    
    'Clear all
    Ws4.Cells.ClearContents
    
    
    'If Found in Ws2 then copy entire row to Ws4
    Set PasteRng = PasteRng.Offset(1, 0) 'One row empty
    Ws3.Range("2:2").Copy Destination:=PasteRng
    Set PasteRng = PasteRng.Offset(1, 0) 'One row header
    
    For Each Ccell In SearchRng
      Set CopyRng = FindRng3.Find(What:=Ccell, LookAt:=xlWhole)
      If Not CopyRng Is Nothing Then
        CopyRng.EntireRow.Copy Destination:=PasteRng
        Set PasteRng = PasteRng.Offset(1, 0)
        Else
        
      End If
            
    Next
    Last edited by SarahPintal; 02-08-2010 at 09:05 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1