title: Compare Columns B and C then shift data
body: <p>I need to compare Column B and C. They consist of real numbers only, sorted in ascending order.</p>
  
  <p>I already have the code for what I want it to do, but I need help changing the range in the code.</p>
  
  <p>So currently code compares Column B and C.</p>
  
  <p><img src="https://i.stack.imgur.com/5aqCz.jpg" alt="Look at this image for more clear explanation."></p>
  
  <p>I need help changing code so I can add a column to the left of A and to the right of D also, and add those to shift range.</p>
  
  <p>Basically, compare E and F and shift <code>B:E</code> and <code>F:I</code>.</p>
  
  <pre><code>Option Explicit
  Sub AlignList()
  ' hiker95, 08/02/2012
  ' http://www.mrexcel.com/forum/showthread.php?651139-Compare-Column-B-amp-C-and-Shift
  Dim r As Long, lr As Long, d As Range
  Application.ScreenUpdating = False
  lr = Cells.Find("*", , xlValues, xlWhole, xlByRows, xlPrevious, False).Row
  Set d = Range("A1:B" &amp; lr)
  r = 1
  Do While d.Cells(r, 2) &lt;&gt; ""
    If d.Cells(r, 2).Offset(, 1) &lt;&gt; "" Then
      If d.Cells(r, 2) &lt; d.Cells(r, 2).Offset(, 1) Then
        d.Cells(r, 2).Offset(, 1).Resize(, 2).Insert -4121
      ElseIf d.Cells(r, 2) &gt; d.Cells(r, 2).Offset(, 1) Then
        d.Cells(r, 1).Resize(, 2).Insert -4121
        lr = lr + 1
        Set d = Range("A1:B" &amp; lr)
      End If
    End If
    r = r + 1
  Loop
  Application.ScreenUpdating = 1
  End Sub
  </code></pre>