VBA: Rearrange columns

[gd6noob]

Hi everyone,

Basically Im trying to rearrange my columns based on the array "Row Labels", "Bereavement", "Provincial Leave", "Medical Waiver". The error happens when it finds Medical Waiver and then cuts.

Not sure how to fix this or if its even the right method.

Row Labels	Bereavement	Medical Waiver	Provincial Leave
1234	Not Used	Not Used	7
1234	Not Used	Not Used	9
1234	Not Used	Not Used	9
1234	Not Used	Not Used	7

*xl2bb crashes when I capture using Mini Sheet. Row Label is A1*

Sub reordercolumns()
    Dim arrColOrder As Variant, ndx As Integer
    Dim Found As Range, Counter As Integer, fc As Range

        arrColOrder = Array("Row Labels", "Bereavement", "Provincial Leave", "Medical Waiver")
       
        Counter = 1
          
        For ndx = LBound(arrColOrder) To UBound(arrColOrder)
       
            Set Found = Range("A1:D1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                              SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
           
            If Not Found Is Nothing Then
                If Found.Column <> Counter Then
                    Found.EntireColumn.Cut
                    Columns(Counter).Insert Shift:=xlToRight
                    Application.CutCopyMode = False
                End If
                Counter = Counter + 1
            End If
           
        Next ndx

End Sub

Thanks for any help.

 

[Akuini]

@gd6noob
Try this:
In the process, the code will change the header by adding sequential number (i.e. "000Row Labels", "001Bereavement",..etc), then sort data Left to Right, then change the header back to their original value.
If you don't like the idea to change the header in the process (in case something goes wrong) then we could use a helper row below the data.

Sub gd6noob()
Dim arrColOrder As Variant, ndx As Integer
Dim Found As Range, Counter As Integer, fc As Range
Dim c As Range, i As Long, g As Range

arrColOrder = Array("Row Labels", "Bereavement", "Provincial Leave", "Medical Waiver")

Set c = Range("A1:D1") 'header

'adding sequential number to each header
For Each x In arrColOrder
res = Application.Match(x, c, 0)
    c.Cells(res) = Format(i, "000") & c.Cells(res)
    i = i + 1
Next

With ActiveSheet.Sort
   .SortFields.Clear
     .SortFields.Add Key:=c, Order:=xlAscending
     .SetRange c.EntireColumn
     .Header = xlNo
     .Orientation = xlLeftToRight
     .Apply
End With

'change the header back to original value
For Each g In c
    g = Mid(g, 4, 1000)
Next

End Sub

 

[gd6noob]

Thank you for this code, it is working.