Rearranging columns in VBA - excel

Question

The current codes I am working on requires me to rearrange the columns in VBA. It has to arranged according to the header, and the headers are "V-d(1)", "V-g(1)", "I-d(1)", "I-g(1)", and this set repeats for numbers 2, 3, etc etc. (e.g V-d(2), I-g(4)). These data are usually jumbled up and I have to arrange them in ascending numbers.
It does not matter if V-g, V-d, I-d or I-g comes first.
Dim num, numadj As Integer
Dim colu, coladj
Range("A1").Select
Do While Range("A1").Offset(0, i - 1).Value <> ""
colu = ActiveCell.Value
coladj = ActiveCell.Offset(0, 1).Value
num = Left(Right(colu.Text, 2), 1)
numadj = Left(Right(coladj.Text, 2), 1)
If num > numadj Then
colu.EntireColumn.Cut Destination:=Columns("Z:Z")
coladj.EntireColumn.Cut Destination:=colu
Columns("Z:Z").Select.Cut Destination:=coladj
i = i + 1
Else
i = i + 1
End If
Loop
I am very new to VBA so please forgive me for any dumb codes that I have created!!! Thank you in advance everyone!

Answer 1

Consider an SQL and RegEx solution to select columns in a specified arrangement. SQL works in Excel for PC which can access Windows' Jet/ACE SQL Engine to query its own workbook like a database table.
Due to the variable nature of sets ranging 3-10, consider finding the highest number set by extracting the numbers from column headers with RegEx using the defined function, FindHighestNumberSet. Then have RunSQL subroutine call the function to build SQL string dynamically.
Below assumes you have data currently in a tab named DATA with an empty tab named RESULTS which will output query results. Two ADO connection strings are available.
Function (iterating across column headers to extract highest number)
Function FindHighestNumberSet() As Integer
Dim lastcol As Integer, i As Integer
Dim num As Integer: num = 0
Dim regEx As Object
' CONFIGURE REGEX OBJECT
Set regEx = CreateObject("VBScript.RegExp")
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[^0-9]"
End With
With Worksheets("DATA")
lastcol = .Cells(7, .Columns.Count).End(xlToLeft).Column
For i = 1 To lastcol
' EXTRACT NUMBERS FROM COLUMN HEADERS
num = Application.WorksheetFunction.Max(num, CInt(regEx.Replace(.Cells(1, i), "")))
Next i
End With
FindHighestNumberSet = num
End Function
Macro (main module looping through result of above function)
Sub RunSQL()
On Error GoTo ErrHandle
Dim conn As Object, rst As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' DRIVER AND PROVIDER CONNECTION STRINGS
' strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "DBQ=" & Activeworkbook.FullName & ";"
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='" & ActiveWorkbook.FullName & "';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
' FIRST THREE SETS
strSQL = " SELECT t.[V-d(1)], t.[I-d(1)], t.[I-g(1)]," _
& " t.[V-d(2)], t.[I-d(2)], t.[I-g(2)]," _
& " t.[V-d(3)], t.[I-d(3)], t.[I-g(3)]"
' VARIABLE 4+ SETS
For i = 4 To FindHighestNumberSet
strSQL = strSQL & ", t.[V-d(" & i & ")], t.[I-d(" & i & ")], t.[I-g(" & i & ")]"
Next i
' FROM CLAUSE
strSQL = strSQL & " FROM [DATA$] t"
' OPEN DB CONNECTION
conn.Open strConnection
rst.Open strSQL, conn
' COLUMN HEADERS
For i = 1 To rst.Fields.Count
Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A2").CopyFromRecordset rst
rst.Close: conn.Close
Set rst = Nothing: Set conn = Nothing
MsgBox "Successfully ran SQL query!", vbInformation
Exit Sub
ErrHandle:
Set rst = Nothing: Set conn = Nothing
MsgBox Err.Number & " = " & Err.Description, vbCritical
Exit Sub
End Sub

Answer 2

You can sort vertically by a helper row with something like this (tested):
Sub test() ': Cells.Delete: [b2:d8] = Split("V-d(10) V-d(2) V-d(1)") ' used for testing
Dim r As Range: Set r = ThisWorkbook.Worksheets("Sheet1").UsedRange ' specify the range to be sorted here
r.Rows(2).Insert xlShiftDown ' insert helper row to sort by. (used 2nd row instead 1st so that it is auto included in the range)
r.Rows(2).FormulaR1C1 = "=-RIGHT(R[-1]C,LEN(R[-1]C)-3)" ' to get the numbers from the column header cells above, so adjust if needed
r.Sort r.Rows(2) ' sort vertically by the helper row
r.Rows(2).Delete xlShiftUp ' delete the temp row
End Sub