Moving Columns based on header name

Question

I have a macro that rearranges the columns into a particular order.

Sub ArrangeColumns()

\' ArrangeColumns Macro

    Columns(\"C:C\").Select
    Applicatio         


        

Answer 1

Alternative using Application.Index in a one liner

For the sake of the art and just to demonstrate a working alternative using the advanced restructuring possibilities of the Application.Index function (c.f. section [2]):

Sub colOrder()
' Purpose: restructure range columns
  With Sheet1                                               ' worksheet referenced e.g. via CodeName

    ' [0] identify range
      Dim rng As Range, lastRow&, lastCol&
      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:" & lastRow & ")"), 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

Helper function called by above main procedure

The helper function simply returns an array with the correct column numbers found in the current titles; it uses Application.Match to find occurrencies:

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&, ii&, 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

Related link

I listed some pecularities of the Application.Index function at Insert first column in datafield array without loops or API calls

Answer 2

If you know all the header names, you can define an array of the header names and use the array's index to move the columns around.

Sub columnOrder()
Dim search As Range
Dim cnt As Integer
Dim colOrdr As Variant
Dim indx As Integer

colOrdr = Array("id", "last_name", "first_name", "gender", "email", "ip_address") 'define column order with header names here

cnt = 1


For indx = LBound(colOrdr) To UBound(colOrdr)
    Set search = Rows("1:1").Find(colOrdr(indx), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not search Is Nothing Then
        If search.Column <> cnt Then
            search.EntireColumn.Cut
            Columns(cnt).Insert Shift:=xlToRight
            Application.CutCopyMode = False
        End If
    cnt = cnt + 1
    End If
Next indx
End Sub

Any column not named in the array will appear on the right of the ones named.