title: Aligning rows of tables by matching first elements
body: <p>Seeking direction from proper VBA programmers of how I could best approach writing some tricky code efficiently. I seek to align two tables A and B of dimensions [<em>n</em> X 4] and [<em>m</em> X 5] respectively.</p>
  <p>The conditions are:</p>
  <ol>
  <li>a match between the tables first element of every nth and mth row determines alignment.</li>
  <li>A (left) and B (right) are neighbours but B is fixed. So, only rows in A can reorder to align properly with matched rows of the mth element in B.</li>
  <li>Attached is a representation of the procedure -</li>
  </ol>
  <p>List item</p>
  <p><a href="https://i.stack.imgur.com/5lvFf.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/5lvFf.png" alt="enter image description here" /></a></p>
  <p>Various Q&amp;A sites (including Stackoverflow) do not address the specific conditions imposed by my problem.</p>
  <p>Example  of code so far:</p>
  <pre><code>
      Dim t1s As Long: t1s = 1 ' start column of table 1
      Dim t2s As Long: t2s = 6 ' start column of table 2
      Dim t1l As Long: t1l = 5 - 1 ' length of columns of table 1 (-1)
      Dim t2l As Long: t2l = 6 - 1 ' length of columns on table 2 (-1)
  
      Dim startRow As Long: startRow = 2
  
      Dim r As Long ' current row var
      Dim rMatch As Long ' to hold matching row on table 2
  
      With Rec_9 ' change to whatever worksheet you're using
          For r = startRow To .Cells(.Rows.Count, t1s).End(xlUp).Row ' cycle through to last row
              If Application.WorksheetFunction.CountIf(.Columns(t2s), .Cells(r, t1s).Value) &gt; 0 Then
      
                  rMatch = Application.WorksheetFunction.Match(.Cells(r, t1s).Value, .Columns(t2s), 0)
              
                  .Range(Cells(rMatch + 1, t2s), Cells(rMatch + 1, t2s + t2l)).Insert shift:=xlDown
                  .Range(Cells(rMatch + 1, t2s), Cells(rMatch + 1, t2s + t2l)).Value2 = &quot;*&quot;
              
                  .Range(Cells(rMatch, t1s), Cells(rMatch, t1s + t1l)).Insert shift:=xlDown
                  .Range(Cells(rMatch, t1s), Cells(rMatch, t1s + t1l)).Value2 = .Range(Cells(r + 1, t1s), Cells(r + 1, t1s + t1l)).Value2
              
                  .Range(Cells(r + 1, t1s), Cells(r + 1, t1s + t1l)).Value2 = &quot;*&quot;
              
                  r = r + 1 ' make sure to skip the next row since one has been inserted to avoid infinite looping
              
              End If
          Next r
      End With
          
      Application.ScreenUpdating = True
      
  End Sub
  </code></pre>