VBA Looking for code to reorder columns

L

LNG2013

Active Member
Joined
May 23, 2011
Messages
466
Hey all! I'm looking for some wicked VBA code to help me put my columns in a specific order! Here's the catch I need to do it by the column's name (first row values), not by the letter.

All help is appreciated!
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG26May29
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] J [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp
[COLOR="Navy"]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR="Navy"]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR="Navy"]For[/COLOR] J = i To rng.Columns.Count
        [COLOR="Navy"]If[/COLOR] rng(J) < rng(i) [COLOR="Navy"]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] J
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hey MickG thanks for the code, but this seems to put them in alphabetical order. I was looking more for something that would allow me to put the column in the order I specifiy for example:

Current row headers Year, Order#, Address, Week, Last Name, ItemID, Month, FirstName (it goes on from here this is just a sample)

Change To: Order#, ItemID, FirstName, LastName, Address, Week, Month, Year

MickG said:
Try this:-
Code: 
[COLOR=navy]Sub[/COLOR] MG26May29
[COLOR=navy]Dim[/COLOR] rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] i [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] J [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Temp
[COLOR=navy]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR=navy]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR=navy]For[/COLOR] J = i To rng.Columns.Count
        [COLOR=navy]If[/COLOR] rng(J) < rng(i) [COLOR=navy]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] J
[COLOR=navy]Next[/COLOR] i
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
Try this:-
Make sure all your headers are in the array "Nams" (in their final order) and that your data is the extent of your CurrentRegion (No more Data-After )
Code: 
[COLOR="Navy"]Sub[/COLOR] MG26May36
[COLOR="Navy"]Dim[/COLOR] rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] J [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp
[COLOR="Navy"]Dim[/COLOR] nams [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] F
[COLOR="Navy"]Dim[/COLOR] Dex [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
nams = Array("ItemID", "FirstName", "LastName", "Address", "Week", "Month", "Year")
[COLOR="Navy"]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR="Navy"]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR="Navy"]For[/COLOR] J = i To rng.Columns.Count
        [COLOR="Navy"]For[/COLOR] F = 0 To UBound(nams)
            [COLOR="Navy"]If[/COLOR] nams(F) = rng(J) [COLOR="Navy"]Then[/COLOR] Dex = F: [COLOR="Navy"]Exit[/COLOR] For
        [COLOR="Navy"]Next[/COLOR] F
        [COLOR="Navy"]If[/COLOR] F < i [COLOR="Navy"]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] J
[COLOR="Navy"]Next[/COLOR] i
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hey MickG this worked, only one small issue.... some of the original columns have dates and times attributed to them, when clumns are mve the date setting is applied incorrectly to some of columns. Any ideas on how to fix?


MickG said:
Try this:-
Make sure all your headers are in the array "Nams" (in their final order) and that your data is the extent of your CurrentRegion (No more Data-After )
Code: 
[COLOR=navy]Sub[/COLOR] MG26May36
[COLOR=navy]Dim[/COLOR] rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] i [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] J [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Temp
[COLOR=navy]Dim[/COLOR] nams [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] F
[COLOR=navy]Dim[/COLOR] Dex [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
nams = Array("ItemID", "FirstName", "LastName", "Address", "Week", "Month", "Year")
[COLOR=navy]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR=navy]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR=navy]For[/COLOR] J = i To rng.Columns.Count
        [COLOR=navy]For[/COLOR] F = 0 To UBound(nams)
            [COLOR=navy]If[/COLOR] nams(F) = rng(J) [COLOR=navy]Then[/COLOR] Dex = F: [COLOR=navy]Exit[/COLOR] For
        [COLOR=navy]Next[/COLOR] F
        [COLOR=navy]If[/COLOR] F < i [COLOR=navy]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] J
[COLOR=navy]Next[/COLOR] i
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
Click to expand...
 
Upvote 0
Alternatively you can sort the worksheet from left to right using a custom list instead of A-Z.
 
Upvote 0
I'm confident it will because the cells are being moved en bloc rather than the cell values being moved from one cell to another.

In any case it will take mere seconds to test.
 
Upvote 0
MickG said:
Try this:-
Make sure all your headers are in the array "Nams" (in their final order) and that your data is the extent of your CurrentRegion (No more Data-After )
Code: 
[COLOR=Navy]Sub[/COLOR] MG26May36
[COLOR=Navy]Dim[/COLOR] rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] i [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] J [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Temp
[COLOR=Navy]Dim[/COLOR] nams [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] F
[COLOR=Navy]Dim[/COLOR] Dex [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
nams = Array("ItemID", "FirstName", "LastName", "Address", "Week", "Month", "Year")
[COLOR=Navy]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR=Navy]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR=Navy]For[/COLOR] J = i To rng.Columns.Count
        [COLOR=Navy]For[/COLOR] F = 0 To UBound(nams)
            [COLOR=Navy]If[/COLOR] nams(F) = rng(J) [COLOR=Navy]Then[/COLOR] Dex = F: [COLOR=Navy]Exit[/COLOR] For
        [COLOR=Navy]Next[/COLOR] F
        [COLOR=Navy]If[/COLOR] F < i [COLOR=Navy]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] J
[COLOR=Navy]Next[/COLOR] i
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...


This is just amazing, thank you so much.
 
Upvote 0
HI,

I'm using the formula but cant seem to know why there would be an overflow error in this command?

I hav3 33 Coulmns to Arrannge and I have included all names on the Nams Array.

Thanks for the help.



Sub ArrangeColumns()
Dim rng As Range
Dim i As Long
Dim AJ As Long
Dim Temp
Dim nams As Variant
Dim AF
Dim Dex As Integer
nams = Array("Business Unit", "Internal Part Number", "IPN Description", "Site Id", "Supplier ID", _
"Supplier Name", "MPN", "MFR", "Division ID", "Division Name", "MatDec", "FMD", "PMD", "PMD Date", _
"Site Name", "Material Allocation", "Commodity Code", "Commodity Description", "Commodity Family", _
"Site (Local) Supplier ID", "Site (Local) Supplier Name", "Parent Supplier ID", "Parent Supplier Name", _
"Supplier Country", "Month Added", "Owner", "Engineer", "REGION", "MADN", "Matdec Origin", "DFC", "PMD Dropped", "Final FY14 Tagging_POC")
Set rng = Range("A1").CurrentRegion
For i = 1 To rng.Columns.Count
For AJ = i To rng.Columns.Count
For AF = 0 To UBound(nams)
If nams(AF) = rng(AJ) Then Dex = AF: Exit For
Next AF
If AF < i Then
Temp = rng.Columns(i).Value
rng(i).Resize(rng.Rows.Count) = rng.Columns(AJ).Value
rng(AJ).Resize(rng.Rows.Count) = Temp
End If
Next AJ
Next i
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
VBA code to select first digit/letter of each column
Replies
5
Views
123
Peter_SSs
Peter_SSs
A
  • Question Question
Looking for vba or formula help
2
Replies
11
Views
157
Peter_SSs
Peter_SSs
J
  • Question Question
Vlookup or xlookup or index match multiple columns
Replies
3
Views
362
Fluff
Fluff
C
  • Question Question
VBA code to select all columns contain any data in specific row
Replies
2
Views
343
Peter_SSs
Peter_SSs
J
  • Question Question
Pulling Data From ~300 Individual Sheets Onto a Master Sheet
Replies
1
Views
199
ranman256
ranman256

Forum statistics

Threads
1,224,613
Messages
6,179,903
Members
452,948
Latest member
Dupuhini

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top