reorder columns vba

Question

Sorry I can not find were I got this code

The code Reorders columns base on a list of all column in a sheet

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

There are Copy-paste versions of this but they are very slow and not suited to a large number of columns

I only want to list the columns I want to be reordered to the beginning of the sheet, all other columns left in the order they were in after the reordered listed columns

Have had no luck doing this

Thanks

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 currencies:

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

Answer 1

Rearranging columns due to title list

"I only want to list the columns I want to be reordered to the beginning of the sheet all other columns left in the order they were in after the reordered listed columns"

It suffices

1. to add an (optional) 2nd argument DeleteRestto the help function getColNums,
2. to insert a negative filtering routine in a) to get the remaining titles (array rest) and
3. to insert a conditional code block b) executing the argument's "order" passed by default not to delete unlisted titles

    If Not DeleteRest Then
        For i = 0 To UBound(rest)
            pos = Application.Match(rest(i), titles, 0)             ' check positions
            If Not IsError(pos) Then
                tmp(ii) = pos: ii = ii + 1
            End If
        Next i
    End If

(and you could leave the calling procedure ColOrder unchanged - see section [2])

Modified help function getColNums()

Only in case that the 2nd argument DeleteRest (which is False by default) will be passed intently as True each unlisted column would now be removed. Otherwise there's no more need to list the entire title set to prevent deletion.

Function getColNums(arr, Optional ByVal DeleteRest As Boolean = False) As Variant()
' Site: https://stackoverflow.com/questions/61918751/reorder-columns-vba
' Purp: return array of found column number order, e.g. Array(3,2,1,4,6,5)
' Auth: https://stackoverflow.com/users/6460297/t-m
' Date: 2020-05-25
' Note: if argument DeleteRest (default: False) is passed as True, each unlisted titles will be removed
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 rest: rest = titles
Dim i&, ii&, pos                                                ' array counters, element position
ReDim tmp(0 To UBound(colOrdr) + UBound(titles) + 2)            ' temporary array to collect found positions
' a) find position in
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
        rest = Filter(rest, colOrdr(i), False, vbTextCompare)
    End If
Next i
' b) Default: ~~~> don't remove unlisted titles  <~~~           ' << inserted code block as of 2020-05-15 >>
If Not DeleteRest Then
    For i = 0 To UBound(rest)
        pos = Application.Match(rest(i), titles, 0)             ' check positions
        If Not IsError(pos) Then
            tmp(ii) = pos: ii = ii + 1
        End If
    Next i
End If

ReDim Preserve tmp(0 To ii - 1)                                 ' remove empty elements
getColNums = tmp                                                ' return array with current column numbers (1-based)
Debug.Print Join(tmp, "|") & " ... " & Join(rest, "|")
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