Swapping (Rearranging) Multiple Columns of Data

[Rick Rothstein]

**** Corrected Code (Shown In Red Below) As Of October 20, 2013 ****

How do you rearrange columns of data? That question seems to come up every now and again on the various forums I frequent. As a matter-of-fact, it just came up on one yesterday to which I responded with a rather short macro. The request was this...

I have data in columns from Range (A:AJ) and I want to re arrange the same data in the following order

C,B,E,F,H,AC,K,AF,T,M,S,G,X,I,Z,AA,L,AG,AE,AH,AD,A I,A,D,J,N,O,P,Q,R,U,V,W,Y,AB,AJ

Now moving that much data around looks like it might be a formidable task, but as it turned out, only 8 active code lines, including the Dim statement, were needed. The reason such a short macro was possible is because of the tremendous power of the INDEX worksheet function which VBA provides access to. Now I could try to explain how the INDEX function works, but I'm sure my attempts would fall woefully short. I will say, though, that everything I know about the Index function came from a fantastic blog article that Daniel Ferry posted back in March 2011. Here is a link to that article which I highly recommend for reading... The Imposing INDEX

Okay, now for the macro...

Sub RearrangeColumns()
  Dim X As Long, LastRow As Long, Letters As Variant, NewLetters As Variant
  Const NewOrder As String = "C,B,E,F,H,AC,K,AF,T,M,S,G,X,I,Z,AA,L,AG,AE,AH,AD,AI,A,D,J,N,O,P,Q,R,U,V,W,Y,AB,AJ"
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Letters = Split(NewOrder, ",")
  ReDim NewLetters(1 To UBound(Letters) + 1)
  For X = 0 To UBound(Letters)
    NewLetters(X + 1) = Columns(Letters(X)).Column
  Next
  Range("A1").Resize(LastRow, UBound(Letters) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), NewLetters)
End Sub

Simply assign the new column order to the NewOrder constant (the Const statement) as a comma delimited text string of column letters (no spaces around the commas) and run the macro. That's it... this short piece of code will do the rest... and it will do it quite quickly I might add.

[littleiitin]

one word-- "Amazed"

[snb]

A sorting alternative:

Sub snb()
  sn = Split("C,F,A,G,B,J,E,D,I,H", ",")
  For j = 0 To UBound(sn)
    sn(j) = Columns(sn(j)).Column
  Next

  Cells(1).CurrentRegion.Rows(1).Offset(Cells(1).CurrentRegion.Rows.Count) = sn
  With Cells(1).CurrentRegion
    .Sort Cells(.Rows.Count, 1), , , , , , , , , , xlSortRows
    .Rows(.Rows.Count).ClearContents
  End With
End Sub

or if the number of columns doesn't exceed the alphabet:

Sub snb_002()
  Cells(1).CurrentRegion.Offset(10) = Application.Index(Cells(1).CurrentRegion, Evaluate("Row(" & Cells(1).CurrentRegion.Address & ")"), [transpose(code(mid("CFAGBJEDIH",row(1:10),1))-64)])
end sub

[Rick Rothstein]

Sub RearrangeColumns()
  Dim X As Long, LastRow As Long, Letters As Variant
  Const NewOrder As String ="C,B,E,F,H,AC,K,AF,T,M,S,G,X,I,Z,AA,L,AG,AE,AH,AD,AI,A,D,J,N,O,P,Q,R,U,V,W,Y,AB,AJ"
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  Letters = Split(NewOrder, ",")
   For X = 0 To UBound(Letters)
    Letters(X) = Columns(Letters(X)).Column
  Next
  Range("A1").Resize(LastRow, UBound(Letters)) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), Letters)
End Sub

Sub snb()
  sn = Split("C,F,A,G,B,J,E,D,C,H", ",")
  For j = 0 To UBound(sn)
    sn(j) = Columns(sn(j)).Column
  Next

  Cells(1).CurrentRegion.Rows(1).Offset(Cells(1).CurrentRegion.Rows.Count) = sn
  With Cells(1).CurrentRegion
    .Sort Cells(.Rows.Count, 1), , , , , , , , , , xlSortRows
    .Rows(.Rows.Count).ClearContents
  End With
End Sub

While I haven't tried it out, your code looks like it should work, but personally, I think your "sort order string" would be harder to set up than mine. With mine, you just look at the columns in the order you want them to be ("I want C first, then B, then E, etc.") and then write the column letters down in that order... easy to do by sight. With your method, I would have to know where the column will end up at after the sort so that I can write those column letters down in that order instead ("A will be C in the new order, B will be F in the new order, C will be A in the new order, etc.)... which, to me, does not seem as easy to do. However, you have offered a valid alternative approach to the problem, so I thank you for that.

[snb]

With your method, I would have to know where the column will end up at after the sort

I don't think so. It's meant to use the same method you use to indicate the order of the columns.

I also added a oneliner alternative in case the currentregion/usedrange doesn't consist of more than 26 columns.

[Rick Rothstein]

I don't think so. It's meant to use the same method you use to indicate the order of the columns.

Sorry, you are correct... we both are using the same method for delineating the order for the rearranged columns. I thought I had detected a "relationship" between our two posted "new order" example strings and responded based on that. I just tested your code and it works quite well also, although I would note your code requires the insertion and removal of a helper column to do its work (no big deal that, just pointing out a difference between our methods as it affects the sheet being processed). One personal observation... I really wish you would declare your variables (I use Option Explicit in all my procedures and had to disable it in order to stop the error it generates when testing your code).

[snb]

That's my problem too: I always have to remove the option explicit and declaration lines in code I copy from others.

[snb]

To overcome the restrictions (<= 26 columns) of my earlier posted code I made up this one, in which the sorting essentially takes place in a oneliner code.

Sub snb()
  Cells(1).CurrentRegion.Name = "snb_002"
  Names.Add "snb_01", [{"C";"B";"E";"F";"H";"AC";"K";"AF";"T";"M";"S";"G";"X";"I";"Z";"AA";"L";"AG";"AE";"AH";"AD";"AI";"A";"D";"J";"N";"O";"P";"Q";"R";"U";"V";"W";"Y";"AB";"AJ"}]

  [snb_002].Offset(10) = Application.Index([snb_002], [row(snb_002)], [transpose(match(index(snb_01,,column(snb_002))&1,address(1,row(1:52),4),0))])
end sub

I have been looking for a solution in which the Application.Index would have been part of the 'between brackets' evaluation, but I wasn't able to construct a successful one.

[Rick Rothstein]

To overcome the restrictions (<= 26 columns) of my earlier posted code I made up this one, in which the sorting essentially takes place in a oneliner code.

Sub snb()
  Cells(1).CurrentRegion.Name = "snb_002"
  Names.Add "snb_01", [{"C";"B";"E";"F";"H";"AC";"K";"AF";"T";"M";"S";"G";"X";"I";"Z";"AA";"L";"AG";"AE";"AH";"AD";"AI";"A";"D";"J";"N";"O";"P";"Q";"R";"U";"V";"W";"Y";"AB";"AJ"}]

  [snb_002].Offset(10) = Application.Index([snb_002], [row(snb_002)], [transpose(match(index(snb_01,,column(snb_002))&1,address(1,row(1:52),4),0))])
end sub

I have been looking for a solution in which the Application.Index would have been part of the 'between brackets' evaluation, but I wasn't able to construct a successful one.

Sorry, I cannot agree with you that your code "essentially takes place in a oneliner code"... it looks like three lines to me. On top of that, I think you should be "nice" to the person running macro and provide addition code to remove the Defined Names you created within the code. As for the square bracket form of Evaluate... besides, if memory serves correctly, it being documented as slower than using the Evaluate function directly, you cannot construct expressions to evaluate by concatenating text and variables from you VB code together the way you can with the Evaluate function (which takes a String argument).

[snb]

I was talking about the sorting......