Rearrange the excel columns by the columns header name

[sonypcg]

How could I rearrange the columns by the columns header name.
I need to process a report on weekly basis,the raw worksheet has 23 columns.I abstract a part of them as example.
Raw columns sequence：

[TABLE="width: 500"]
<tbody>[TR]
[TD]QTY[/TD]
[TD]Payment Terms[/TD]
[TD]Contract No.[/TD]
[/TR]
</tbody>[/TABLE]



Desired columns sequence:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Contract No.[/TD]
[TD]Payment terms[/TD]
[TD]QTY[/TD]
[/TR]
</tbody>[/TABLE]


Any idea how to automatize the columns rearrangement with VBA code?
Many thanks in advance.

 

[sonypcg]

Re: How to rearrange the excel columns by the columns header name

Is the application would be like as following. Can you delight me. Sry currently I don't have decent knowledge of VBA coding yet.
Sub SortCols()
Dim lColumn As Long
lColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim LastRow As Long
LastRow = Cells.Find("Contract No.", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = Cells.Find("Payment terms", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastRow = Cells.Find("QTY", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Range(Cells(1, 1), Cells(LastRow, lColumn)).Sort Key1:=Range(Cells(1, 1), Cells(1, lColumn)), Order1:=xlAscending, Orientation:=xlLeftToRight
End Sub

 

[Rick Rothstein]

Re: How to rearrange the excel columns by the columns header name

Actually the whole picture would be more complicated than my abstracted columns example,which I am unable to sort it out in alphabetical order with build in sort function
[TABLE="width: 1280"]
<tbody>[TR]
[TD="width: 64"]Fulfillment Center[/TD]
[TD="width: 64"]Region[/TD]
[TD="width: 64"]Country[/TD]
[TD="width: 64"]Office[/TD]
[TD="width: 64"]Orig Contract No.[/TD]
[TD="width: 64"]Order No[/TD]
[TD="width: 64"]BSA Line NO.[/TD]
[TD="width: 64"]Delivery Detail[/TD]
[TD="width: 64"]Delivery Id[/TD]
[TD="width: 64"]Order Line No.[/TD]
[TD="width: 64"]Apply Line[/TD]
[TD="width: 64"]Order Qty[/TD]
[TD="width: 64"]Qty[/TD]
[TD="width: 64"]Unit price[/TD]
[TD="width: 64"]Amount[/TD]
[TD="width: 64"]Currency[/TD]
[TD="width: 64"]Amount USD[/TD]
[TD="width: 64"]Delivery Batch[/TD]
[TD="width: 64"]Product Code[/TD]
[TD="width: 64"]Item[/TD]
[/TR]
</tbody>[/TABLE]

What order do you want your final copy to be... alphabetical or in the order shown above?

 

[mumps]

Re: How to rearrange the excel columns by the columns header name

I had to go for an appointment. I will respond as soon as possible.

 

[MickG]

Re: How to rearrange the excel columns by the columns header name

Try this:-
Place your Headers (In the Correct order that you want) in the code array where shown:_
The code should automatically find those Headers in Range "A1:W1" and then create an array to show the correct results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG02Oct21
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, H [COLOR="Navy"]As[/COLOR] Variant, Hds [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Cells(1).CurrentRegion.Resize(, 23)
ReDim nRay(1 To UBound(Ray, 1), 1 To UBound(Ray, 2))
'[COLOR="Green"][B]Place the Names of your header in Order that you want in the Array below[/B][/COLOR]
Hds = Array("Header1", "Header2", "Header3", "Header4", "Header5", "Header6", "Header7", "Header8", "Header9", "Header10", "Header11", "Header12", "Header13", "Header14", "Header15", "Header16", "Header17", "Header18", "Header19", "Header20", "Header21", "Header22", "Header23")
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1:W1")
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] H [COLOR="Navy"]In[/COLOR] Hds
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Dn.Value = H [COLOR="Navy"]Then[/COLOR]
            .Item(H) = Dn.Column
            [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] H
nRay = Application.Index(Ray, Evaluate("ROW(1:" & UBound(Ray, 1) & ")"), Application.Transpose(Application.Transpose(.items)))
Sheets("Sheet2").Range("A1").Resize(UBound(Ray, 1), UBound(Ray, 2)).Value = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[mumps]

Re: How to rearrange the excel columns by the columns header name

Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the menu at the top click 'Insert' and then click 'Module'. Copy and paste the macro (Post #2 ) into the empty code window that opens up. Press the F5 key to run the macro. Close the code module window to return to your sheet. There are other quicker ways to run the macro such as assigning it to a button that you would click on your sheet or assigning it to a short cut key.

 

[sonypcg]

Re: How to rearrange the excel columns by the columns header name

Hi Rick
The desired order is as following,definitely not a alphabetical order

Country	Office	Orig Contract No.	Order No	Fulfillment Center	Product Code	Delivery Id	Delivery Detail	Order Qty	Qty	Unit price	Amount	Currency	Amount USD	Delivery Batch	Item	Apply Line	Order Line No.	BSA Line NO.	Region

 

[sonypcg]

Re: How to rearrange the excel columns by the columns header name

Hi Mumps,many thanks for your kindness.
Your code works great for a alphabetical order sorting,however my problem is a specific order.like Post #16

 

[Rick Rothstein]

Re: How to rearrange the excel columns by the columns header name

Hi Rick
The desired order is as following,definitely not a alphabetical order

Country	Office	Orig Contract No.	Order No	Fulfillment Center	Product Code	Delivery Id	Delivery Detail	Order Qty	Qty	Unit price	Amount	Currency	Amount USD	Delivery Batch	Item	Apply Line	Order Line No.	BSA Line NO.	Region

Okay, the following code will rearrange the active sheet columns whose headers are "out of order" into the above order, in place, on the active sheet (I can copy the reordered columns to another sheet if you want to retain the original raw data in its original order, just tell me the output sheet name). Note that in order for this to work correctly, the spelling for the "out of order" headers must be exactly the same, character for character (letter casing does not matter though) as the spelling for the items listed above. I mention this because I see some No. abbreviations have a dot after them and some don't. With that said, here is the code that will rearrange your columns on the active sheet (quite quickly I might add) to the order shown above...

[table="width: 500"]
[tr]
	[td]Sub RearrangeRawDataColumns()
  Dim X As Long, LastRow As Long, ColCount As Long, NewOrder As Variant, CorrectOrder As Variant
  CorrectOrder = Array("Country", "Office", "Orig Contract No.", "Order NO.", "Fulfillment Center", _
                       "Product Code", "Delivery ID", "Delivery Detail", "Order Qty", "Qty", _
                       "Unit Price", "Amount", "Currency", "Amount USD", "Delivery Batch", "Item", _
                       "Apply Line", "Order Line No.", "BSA Line NO.", "Region")
  LastRow = Cells.Find("*", , xlFormulas, , xlRows, xlPrevious).Row
  ColCount = UBound(CorrectOrder) - LBound(CorrectOrder) + 1
  ReDim NewOrder(LBound(CorrectOrder) To UBound(CorrectOrder))
  For X = LBound(CorrectOrder) To UBound(CorrectOrder)
    NewOrder(X) = Rows(1).Find(CorrectOrder(X), , , xlWhole, , , False, , False).Column
  Next
  Range("A1").Resize(LastRow, ColCount) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), NewOrder)
End Sub[/td]
[/tr]
[/table]

 

[OilEconomist]

Re: How to rearrange the excel columns by the columns header name

Try:

Sub SortCols()
    Dim lColumn As Long
    lColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range(Cells(1, 1), Cells(LastRow, lColumn)).Sort Key1:=Range(Cells(1, 1), Cells(1, lColumn)), Order1:=xlAscending, Orientation:=xlLeftToRight
End Sub

@mumps Thanks for this! After searching and searching I finally found the code I needed! Yours here within! I modified it a bit into a function!

 

[mumps]

You are very welcome.