I have a macro that rearranges the columns into a particular order.
Sub ArrangeColumns()
\' ArrangeColumns Macro
Columns(\"C:C\").Select
Applicatio
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
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.