title: Excel VBA with multiple search criteria and loop until all distinct results are found
body: <p>I'm very new to VBA and have an extremely short deadline, so I apologize if I'm not following all forum guidelines. I'd be greatful for any help you can provide!</p>
  
  <p><strong>Goal:</strong> </p>
  
  <ol>
  <li>Search Sheet1 for keywords (Activity:, Site Address:, Description:, Owner:, Valuation:, Sub Type: and DATE_B:) </li>
  <li>Once keyword is found, offset (0,1)</li>
  <li>Copy value</li>
  <li>On Sheet2, label columns as such: Permit_Type, Permit_Date, Permit_Address, Permit_Desc, Owner and Permit_Val)</li>
  <li>Paste copied value from Sheet1 to the appropriate columns</li>
  <li>Repeat script until all keywords are no longer found Sheet1. In other words, continue throughout Sheet1.</li>
  </ol>
  
  <p><strong>What works:</strong></p>
  
  <ol>
  <li>Creates column names on Sheet2</li>
  <li>Script copies and pastes the first values found</li>
  </ol>
  
  <p><strong>What doesn't work:</strong></p>
  
  <ol>
  <li>Script stops after first values are found </li>
  </ol>
  
  <p><strong>Known issue:</strong>
  I originally had the values copied/pasted on the same Sheet1 in Range O2:U2.  I'm having a hard time removing this command since I just need these values to paste on Sheet2</p>
  
  <p><strong>Data looks like this, about 100 records</strong>
  Most Keywords are in Column A, then the rest in Column E - sorry I couldn't provide a better respresentation!</p>
  
  <pre><code> 'Column A    Column B     Column C    Column D    Column E      Column F Column G G         
   'Activity: B13-0217       Type:  BUILD-M   Sub Type:   Porch   Status: ISSUED
   '
  
   'Parcel:               DATE_B: 09/13/2013  Sq Feet:    
   'Site Address: 123 Main St                     
   'Description:  Patio cover 150 sqft                        
   'Applicant:    ABC Contracting         Phone:  123-456-7890        
   'Owner:    Jane Smith          Phone:  123-456-7890        
   'Contractor:   ABC Contracting         Phone:  123-456-7890        
   'Occupancy:        Use:        Class:      Insp Area:  
   'Valuation:    $3,200.00 Fees Req:     $256.90     Fees Col:   $256.90     Bal Due:    $0.00 
  
   'Activity: B13-0224    Type:  BUILD-M      Sub Type:   Deck    Status: ISSUED
   'Parcel:               DATE_B: 09/27/2013  Sq Feet:    
   'Site Address: 234 South St                        
   'Description:  Install a 682 sqft deck on the east side of the building                        
   'Applicant:    BCA Contracting         Phone:  234-567-1234        
   'Owner:    Joe Smith           Phone:  234-567-1234        
   'Contractor:   BCA Contracting         Phone:  234-567-1234        
   'Occupancy:        Use:        Class:      Insp Area:  
   'Valuation:    $28,000.00 Fees Req:        $1,408.60   Fees Col:   $1,408.60   Bal Due:    $0.00 
  </code></pre>
  
  <p><strong>Below is the script I pieced together.  Any help would be greatly appreciated!</strong></p>
  
  <pre><code>Sub Lafayette_Permit_arrangement_macro()
  
  ' This Macro is intended to arrange the monthly Lafayette Permit
  ' data so that specific data is extracted and organized in a more
  ' usable format for mass import.
  
  
  'Permit Number
  Cells.Find(What:="Activity:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
  Range("O2").Select
      ActiveSheet.Paste
  'Permit Type
   Cells.Find(What:="Sub Type:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
   Range("P2").Select
   ActiveSheet.Paste
  'Permit Issue Date
   Cells.Find(What:="DATE_B:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
   Range("Q2").Select
   ActiveSheet.Paste
  'Permit Address
   Cells.Find(What:="Site Address:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
    Range("R2").Select
    ActiveSheet.Paste
  'Permit Description
   Cells.Find(What:="Description:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
   Range("S2").Select
   ActiveSheet.Paste
  'Permit Owner
   Cells.Find(What:="Owner:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
   Range("T2").Select
   ActiveSheet.Paste
  'Permit Value
   Cells.Find(What:="Valuation:", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Offset(0, 1).Select
      Selection.Copy
   Range("U2").Select
   ActiveSheet.Paste
  
   Range("O2:U2").Select
   Application.CutCopyMode = False
   Selection.Copy
   Sheets("Sheet2").Select
   Range("A2").Select
   ActiveSheet.Paste
   Sheets("Sheet2").Select
   Range("A1").Select
  
   Application.CutCopyMode = False
   'Add PermitNo column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_No"
   Range("A1").Select
   'Add PermitType column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_Type"
   Range("B1").Select
   'Add PermitDate column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_Date"
   Range("C1").Select
   'Add PermitAdd column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_Address"
   Range("D1").Select
   'Add PermitDesc column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_Desc"
   Range("E1").Select
   'Add PermitOwner column to Sheet2
   ActiveCell.FormulaR1C1 = "Owner"
   Range("F1").Select
  'Add PermitVal column to Sheet2
   ActiveCell.FormulaR1C1 = "Permit_Val"
   Range("G1").Select
  
  
  
  
  End Sub
  </code></pre>