title: Comparing substrings with whole strings - split function advanced
body: <p>I have code which works very well for comparing the range <strong>(Col B) in sheet 2</strong> to the range <strong>(col A) in sheet 1</strong>. Upon finding a match, it then copies the adjacent values from <strong>sheet 1 (col B)</strong> into <strong>sheet 2 (col C).</strong> </p>
  
  <blockquote>
    <p><a href="https://i.stack.imgur.com/VF9U9.png" rel="nofollow noreferrer">Sheet 1</a>    <a href="https://i.stack.imgur.com/qCkWN.png" rel="nofollow noreferrer">Sheet 2</a>    <a href="https://i.stack.imgur.com/DTWF5.png" rel="nofollow noreferrer">Sheet 2 current output</a></p>
  </blockquote>
  
  <p>My only issue is that the code does not work for the case that <strong>(col A) in sheet 1</strong> has more than one word in each of the cells. </p>
  
  <p>Any suggestions on how I can get the code to compare not only single words (which it works well for), but also to find and compare two words in order and adjacently? E.g If I have "temperature ramp" in <strong>Sheet 1 (Col A)</strong>, and I have "Perform a temperature ramp" in <strong>(Col B) Sheet 2</strong>, I would like the code to be able to find "temperature ramp". </p>
  
  <p>This is <em>in addition</em> to the code comparing as it does now for single words in (Col A). </p>
  
  <p>The sheet examples and the solution that this code gives is as below: The code removes the temperature ramp, but I would need it to recognize both words together, and if there is no recognition that it keeps the line there without deleting it?</p>
  
  <pre><code>Sub x()
  
      Dim v, vOut(), i As Long, j As Long, k As Long, va, r As Range, r1 As Long
  
      With Sheets("Sheet 1") 'Assumes list of words in A1/B1 and down on "Sheet 1"
          Set r = .Range("A1").CurrentRegion
      End With
  
      With Sheets("Sheet 2") 'Assumes phrases in B1 and down on "Sheet 2"
          v = .Range("B3", .Range("B" &amp; Rows.Count).End(xlUp)).Value
          .Columns(2).ClearContents
      End With
  
      ReDim vOut(1 To UBound(v) * r.Rows.Count, 1 To 2)
  
      For i = LBound(v, 1) To UBound(v, 1)
          va = Split(v(i, 1))
          For j = LBound(va) To UBound(va)
             For r1 = 1 To r.Rows.Count
              If LCase(Application.Trim(va(j))) Like "*" &amp; LCase(r.Cells(r1, 1)) Then
  
              'If LCase(Application.Trim(va(j))) = LCase(r.Cells(r1, 1)) Then
                  k = k + 1
                  vOut(k, 1) = v(i, 1)
                  vOut(k, 2) = r.Cells(r1, 2)
              End If
             Next r1
          Next j
      Next i
  
      Sheets("Sheet 2").Range("B3").Resize(k, 2) = vOut 'Puts results in B1/C1 and down on "Sheet2"
  
      End Sub
  </code></pre>