Swapping (Rearranging) Multiple Columns of Data

**** 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...

Quote:

---

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...

Code:

---

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.

one word-- "Amazed"

A sorting alternative:

Code:

---

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:

Code:

---

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

---

Quote:

---

Originally Posted by Rick Rothstein

Code:

---

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

---

---

Quote:

---

Originally Posted by snb

Code:

---

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.

Quote:

---

Originally Posted by Rick Rothstein

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.

Quote:

---

Originally Posted by snb

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).

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

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.

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.

Quote:

---

Originally Posted by 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.

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.:whistling: 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).

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

I am replying to this thread to alert anyone still subscribed to it that I have made a small, but important, change to the code posted in the original article. Not sure how I, or anyone else making use of the code, did not spot it, but without that +1 that I added to the original code (shown in red there), the output from the function will be missing a column in the output. The reason is that the Letters array is created using the Split function and the lower bound of the array produced by the Split function is always 0... that means to get a count of the number of elements in the array, you must add one to the upper bound of the array in order to include that zeroeth element into the count of elements. Apologies to anyone affected by this oversight on my part.

Sub RearrangeColumns()
Rows(1).Insert
Range("A1:AJ1").Value = Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36)
Range("A:AJ").Sort key1:=Range("A1"), order1:=xlAscending, Orientation:=xlSortRows
Rows(1).Delete
End Sub

Quote:

---

Originally Posted by BobUmlas

Sub RearrangeColumns()
Rows(1).Insert
Range("A1:AJ1").Value = Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36)
Range("A:AJ").Sort key1:=Range("A1"), order1:=xlAscending, Orientation:=xlSortRows
Rows(1).Delete
End Sub

---

I used as many lines of code as I did because I wanted to make the code friendly to users by allowing them to specify the columns using letter references instead of making them count the columns in order to figure out their column numbers. However, going with your specified array, and if we don't count Dim statements as "live" code, I can do it in two lines of code...

Code:

---

Sub RearrangeColumns()
  Dim NewOrder As Variant
  NewOrder = Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36)
  Range("A1").Resize(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, UBound(NewOrder) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row & ")"), NewOrder)
End Sub

---

and if we do not mind counting the number of array elements manually, that can be reduced to a single line of code (albeit a very long one)...

Code:

---

Sub RearrangeColumns()
  Range("A1").Resize(Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row, 36) = Application.Index(Cells, Evaluate("ROW(1:" & Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row & ")"), Array(23, 2, 1, 24, 3, 4, 12, 5, 14, 25, 7, 17, 10, 26, 27, 28, 29, 30, 11, 9, 31, 32, 33, 13, 34, 15, 16, 35, 6, 21, 19, 8, 18, 20, 22, 36))
End Sub

---

http://www.excelfox.com/forum/images...es/biggrin.gif

Wow. This is an older thread, but as far as the content is concerned it is extremely useful. This thread provides a number of great ways to rearrange columns. I have to say that in the past I was using a greatly inferior method. I wanted to throw in a Thank You and let you know that people can definitely still get value from posts whether they are current or not. I know that with my personal experience, I commonly run across threads started in the early 2000's that are extremely useful. Keep up the good work!:cheers: