title: Looping through a long list in VBA and pulling data on the way down
body: <p>I found it difficult to put this into a succinct question, so I'll try my best to explain here.</p>
  
  <p>I have a large list in Excel that looks something like this: (The Original List)</p>
  
  <pre><code>1
  Term1
  Term4
  Term6
  2
  Term1
  3
  Term2
  Term3
  Term5
  4
  Term1
  Term2
  Term3
  Term5
  </code></pre>
  
  <p>Now, I've written a series of scripts to convert this list into a different form, like this: (The Finished Product)</p>
  
  <pre><code>Term 1: 1 2 4
  Term 2: 3 4 
  Term 3: 3 4 
  Term 4: 1
  Term 5: 3 4 
  </code></pre>
  
  <p>However, I feel that my script is very inefficient. First, it pulled all the Terms that appeared in the Original List, aligning them into what would become Column A of the Finished Product. </p>
  
  <p>Then, it rearranged the Original List so that the 'headers' (1, 2, 3, 4...) all appear in the top row, essentially making it horizonal rather than vertical. I'll refer to this as a 'The Library'.</p>
  
  <p>And finally, it contained a loop saying "Wherever Term1 appears in The Library, copy whatever appears in row 1 of that column" (which would be 1, 2, and 4).</p>
  
  <p>However, is there a more efficient way to do this, that doesn't involve making 'The Library'? Could I write something that goes through the Original List and say "wherever 'Term1' appears, pull the first number that appears above it," and so forth.</p>
  
  <p>Apologies if I did a poor job of explaining. Any suggestion or starting point would be very much appreciated. </p>
  
  <p>Edit: The current script, for those interested. The sheet "List" contains the list of Terms in The Finished Product. While the Sheet "Library" contains the Original List re-arranged horizontally. </p>
  
  <pre><code>Sub ListLibraryCompare()
  
      Sheets("List").Select
      Cells.Select
      Selection.ClearContents
      Sheets("Comparison").Select
      Columns("D:D").Select
      Selection.Copy
      Sheets("List").Select
      Columns("A:A").Select
      Selection.Insert Shift:=xlToRight
  
  Dim Rng As Range
  Dim Keyword As Range
  Dim Chunk As Range
  Dim Library As Worksheet
  Dim List As Worksheet
  Dim Bottom As Range
  Dim i As Long
  Dim X As Long
  
  Application.ScreenUpdating = False
  
  i = 1
  X = 0
  
  Set Library = Sheets("Library")
  Set List = Sheets("List")
  
  While i &lt;= 7000
  Set Keyword = List.Range("A" &amp; i)
  Set Bottom = Library.Range("A200").Offset(0, X)
  Set Rng = Library.Range("A1").Offset(0, X)
  Set Chunk = Library.Range(Rng, Bottom) 'Sets Chunk to the range between cells     Rng and Bottom
  
  If IsEmpty(Rng.Value) = True Then
  i = i + 1
  X = 0
  ElseIf Application.WorksheetFunction.CountIf(Chunk, Keyword) = 0 Then 
  X = X + 1
  ElseIf Application.WorksheetFunction.CountIf(Chunk, Keyword) &gt;= 1 Then '
  Rng.Copy
  Keyword.Offset(0, 1).Insert Shift:=xlToRight
  X = X + 1
  End If
  Wend 
  
  End Sub
  </code></pre>