title: reorder columns vba
body: <p>Sorry I can not find were I got this code</p>
  
  <p>The code Reorders columns base on a list of all column in a sheet</p>
  
  <p>It works fast on a large number of columns, but it requires that you list ALL columns in your sheet if you do not it deletes the columns not listed</p>
  
  <p>There are Copy-paste versions of this but they are very slow and not suited to a large number of columns</p>
  
  <blockquote>
    <p>I only want to list the columns I want to be <strong>reordered</strong> to the <em>beginning of the sheet</em>, all <em>other columns left in the order they were in</em> after the reordered listed columns</p>
  </blockquote>
  
  <p>Have had no luck doing this</p>
  
  <p>Thanks</p>
  
  <pre><code>Sub colOrder()
  ' Purpose: restructure range columns
  With Sheet1                                               ' worksheet referenced e.g. via CodeName
  
  ' [0] identify range
    Dim rng As Range, lastRow&amp;, lastCol&amp;
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row        ' get last row and last column
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set rng = .Range(.Cells(1, 1), .Cells(lastRow, lastCol))
  
  ' ~~~~~~~~~~~~
  ' [1] get data
  ' ~~~~~~~~~~~~
    Dim v: v = rng                                        ' assign to 1-based 2-dim datafield array
  
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' [2] restructure column order in array in a one liner
  ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    v = Application.Index(v, Evaluate("row(1:" &amp; lastRow &amp; ")"), getColNums(v))
  
  ' [3] write data back to sheet
    rng = vbNullString                                    ' clear orginal data
    .Range("A1").Resize(UBound(v), UBound(v, 2)) = v      ' write new data
  
  End With
  
  End Sub
  </code></pre>
  
  <p><strong>Helper function called by above main procedure</strong></p>
  
  <p>The helper function simply returns an array with the correct column numbers found in the current titles; it uses <code>Application.Match</code> to find currencies:</p>
  
  <pre><code>Function getColNums(arr) As Variant()
  ' Purpose: return array of found column number order, e.g. Array(3,2,1,4,6,5)
  Dim colOrdr(), titles                                           ' wanted order, current titles
  colOrdr = Array("id", "last_name", "first_name", "gender", "email", "ip_address") 'define column order with header names here
  titles = Application.Transpose(Application.Transpose(Application.Index(arr, 1, 0)))
  
  Dim i&amp;, ii&amp;, pos                                                ' array counters, element position
  ReDim tmp(0 To UBound(colOrdr))                                 ' temporary array to collect found 
  positions
  For i = 0 To UBound(colOrdr)                                    ' loop through titles in wanted order
      pos = Application.Match(colOrdr(i), titles, 0)              ' check positions
      If Not IsError(pos) Then tmp(ii) = pos: ii = ii + 1         ' remember found positions, increment 
  counter
  Next I
  ReDim Preserve tmp(0 To ii - 1)                                 ' remove empty elements
  getColNums = tmp                                                ' return array with current column 
  numbers (1-based)
  End Function
  </code></pre>