Reorder columns using a macro

[stephjayne165]

I have an Excel 2007 spreadsheet where I need to reorder the columns. The column headings are as follows:

<TABLE style="WIDTH: 530pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=700><COLGROUP><COL style="WIDTH: 53pt" span=3 width=70><COL style="WIDTH: 53pt" width=70><COL style="WIDTH: 53pt" span=6 width=70><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 53pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 height=17 width=70>COLUMN1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN5</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN6</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN7</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN8</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN9</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl67 width=70>COLUMN10</TD></TR></TBODY></TABLE>

They need to be rearranged in the following order:

<TABLE style="WIDTH: 530pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=700><COLGROUP><COL style="WIDTH: 53pt" span=10 width=70><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BACKGROUND-COLOR: transparent; WIDTH: 53pt; HEIGHT: 12.75pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 height=17 width=70>COLUMN2</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN4</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN10</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN1</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN9</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN3</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN8</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN7</TD><TD style="BORDER-BOTTOM: windowtext 0.5pt solid; BORDER-LEFT: windowtext; BACKGROUND-COLOR: transparent; WIDTH: 53pt; BORDER-TOP: windowtext 0.5pt solid; BORDER-RIGHT: windowtext 0.5pt solid" class=xl66 width=70>COLUMN5</TD></TR></TBODY></TABLE>

Please bear in mind I've never actually used VBA to script a macro (purely just recording), so keep explainations nice and simple for me!

Also, is there a way for me to tag this onto the end of a macro I've recorded which deletes unwanted data?

Your help is appreciated!

 

[chirp]

if you have some experience with recording macros, what is stopping you from recording this reordering?

 

[stephjayne165]

Doesn't seem to want to record it, I've tried a few times and keep getting a runtime error. Unless there's a better way to reorder them other than inserting new columns then copying and pasting?

 

[chirp]

you shouldnt insert a new column, just cut, and then insert.

just with a quick recorded macro (with the selection bits removed) you should be able to get something like this:

    Columns("A:A").Cut
    Columns("C:C").Insert Shift:=xlToRight
    Columns("D:D").Cut
    Columns("A:A").Insert Shift:=xlToRight
    Columns("G:G").Cut
    Columns("E:E").Insert Shift:=xlToRight

its not fast or elegant but should do what you want (not this code just code like this)

 

[stephjayne165]

Not sure if I'm being blonde or not, but I'm still getting an error. This is what I've got, and this is simply trying to move column B and insert it before column A...

ActiveCell.Offset(0, -8).Columns("A:A").EntireColumn.Select
    Selection.Cut
    ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
    Selection.Insert Shift:=xlToRight

 

[AlphaFrog]

[color=darkblue]Sub[/color] Reorder_Columns()
    
    [color=darkblue]Dim[/color] arrColOrder [color=darkblue]As[/color] [color=darkblue]Variant[/color], ndx [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] Range, counter [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    
    [color=green]'Place the column headers in the end result order you want.[/color]
    arrColOrder = Array("COLUMN2", "COLUMN4", "COLUMN6", "COLUMN10", "COLUMN1", _
                        "COLUMN9", "COLUMN3", "COLUMN8", "COLUMN7", "COLUMN5")
    
    counter = 1
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]For[/color] ndx = [color=darkblue]LBound[/color](arrColOrder) [color=darkblue]To[/color] [color=darkblue]UBound[/color](arrColOrder)
    
        [color=darkblue]Set[/color] Found = Rows("1:1").Find(arrColOrder(ndx), LookIn:=xlValues, LookAt:=xlWhole, _
                          SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
            [color=darkblue]If[/color] Found.Column <> counter [color=darkblue]Then[/color]
                Found.EntireColumn.Cut
                Columns(counter).Insert Shift:=xlToRight
                Application.CutCopyMode = [color=darkblue]False[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            counter = counter + 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        
    [color=darkblue]Next[/color] ndx
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

 

[mirabeau]

maybe you can try this.

the reordering criteria are given in the third line (or you can enter them manually directly onto the first line of the worksheet if you like)

Sub reorder_cols()
Rows(1).Insert
Cells(1).Resize(, 10) = [{2, 4, 1, 10, 6, 9, 3, 8, 7, 5}]
Columns(1).Resize(, 10).Sort Cells(1), 1, Orientation:=xlLeftToRight
Rows(1).Delete
End Sub

 

[mirabeau]

hmm ...

best that you ignore my above post #7, I must have been thinking of the wrong problem

 

[stephjayne165]

Thanks for your help guys! Got there in the end, thanks for that coding AlphaFrog, worked brilliantly

 

[mirabeau]

just for completeness (right problem this time)

Sub reorder_cols2()
Dim crit, u()
Dim j As Long, cls As Long

crit = Array(2, 4, 6, 10, 1, 9, 3, 8, 7, 5)
cls = UBound(crit) + 1
ReDim u(1 To cls)
For j = 1 To cls
    u(crit(j - 1)) = j
Next j

Cells.Resize(1).Insert
Cells.Resize(1, cls) = u
Cells.Resize(, cls).Sort Cells(1), 1, Orientation:=xlLeftToRight
Cells.Resize(1).Delete
End Sub