how to rearrange columns quickly

vics_roo

Board Regular
Joined
Apr 3, 2015
Messages
75
Hi,

I need to rearrange columns. I do that by following code

Code:
Sub rearrangeColumns3()
  
    Dim arrNames(21) As String

    arrNames(0) = "№ s/r"
    arrNames(1) = "Date"
    arrNames(2) = "Dept"
    arrNames(3) = "View2"
    arrNames(4) = "Name"
    arrNames(5) = "DC2"
    arrNames(6) = "Group"
    arrNames(7) = "Curr"
    arrNames(8) = "Dept2"
    arrNames(9) = "ID"
    arrNames(10) = "Num/account"
    arrNames(11) = "Name account"
    arrNames(12) = "Sum1"
    arrNames(13) = "Sum2"
    arrNames(14) = "Date2"
    arrNames(15) = "Status"
    arrNames(16) = "Year"
    arrNames(17) = "Num/account2"
    arrNames(18) = "Name_dept"
    arrNames(19) = "Events"
    arrNames(20) = "Comments"
   
    Dim i As Long
    Dim findValue As Variant
    Dim headerCell As Range
    Dim iNum As Long
    
    Dim lFirstRow As Long
    lFirstRow = 2
    
    For i = LBound(arrNames) To (UBound(arrNames) - 1)
        findValue = arrNames(i)
        iNum = iNum + 1
        Set headerCell = ActiveSheet.Rows(lFirstRow).Find(What:=findValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not headerCell.Column = iNum Then
            Columns(headerCell.Column).Cut
            Columns(iNum).Insert Shift:=xlToRight
        End If
    Next i
End Sub


The problem the code working slowly if i have 40000 rows or more...
I checked it by
Code:
MsgBox "6=>" & (Timer - t)
t = Timer

rearrangeColumns3
    
MsgBox "7=>" & (Timer - t)
The value Here is 965.56

So how i can do that more quick ?

Thanks
 
Last edited:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Try this:

Code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
...
put code here
...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
 
Upvote 0
Try this:

Code:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
...
put code here
...
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Thank you for your reply.
I checked, it doesn't help to do faster processing.:(
 
Upvote 0
Would you care to explain in words where you want these column moved to.

For example give column arrangements now and what you want them to look like at the end.
Give me column numbers or column letter like "A" do not give me column header names.

For example:

Now:

ABCDEFGHIJKLMNOP

After:

CDGAMN etc.

Can we copy theses rows into another sheet if so give me both sheet names.
 
Last edited:
Upvote 0
I need to rearrange columns.
Will the columns that you want to rearrange always be in the same fixed order (every time) before you run your code? If so, what is that current order; list their column headers in the order they appear for us, like this...

Column 1's header
Column 2's header
Column 3's header
etc.
 
Upvote 0
Will the columns that you want to rearrange always be in the same fixed order (every time) before you run your code? If so, what is that current order; list their column headers in the order they appear for us, like this...

Column 1's header
Column 2's header
Column 3's header
etc.


Yes, I prepared all data the same fixed order
Here is my code to set headers for source data

Code:
Sub doHeader(wb As Workbook, sSheetName As String)
 
    wb.Worksheets(sSheetName).Activate
    Dim arrNames(22) As String
 
   arrNames(0) = "№ s/r "
    arrNames(1) = "View1"
    arrNames(2) = "DC2"
    arrNames(3) = "Group "
    arrNames(4) = "Curr "
    arrNames(5) = "Dept "
    arrNames(6) = "ID"
    arrNames(7) = "Num/account "
    arrNames(8) = "Name account "
    arrNames(9) = "Sum1"
    arrNames(10) = "Sum2"
    arrNames(11) = "Date2"
    arrNames(12) = "Status "
    arrNames(13) = "Year "
    arrNames(14) = "Num/account2"
    arrNames(15) = "Name_dept "
    arrNames(16) = "Events "
    arrNames(17) = "Comments "
    arrNames(18) = "Dept2 "
    arrNames(19) = "Date "
    arrNames(20) = "View2"
    arrNames(21) = "Name"
 
    Dim i As Long
    For i = 0 To UBound(arrNames) - 1
        Cells(1, i + 1) = i + 1
        Cells(2, i + 1) = arrNames(i)
    Next i
End Sub

These data columns need to be converted into following order

Code:
Sub rearrangeColumns3()
    Dim arrNames(21) As String
 
    arrNames(0) = "№ s/r"
    arrNames(1) = "Date"
    arrNames(2) = "Dept"
    arrNames(3) = "View2"
    arrNames(4) = "Name"
    arrNames(5) = "DC2"
    arrNames(6) = "Group"
    arrNames(7) = "Curr"
    arrNames(8) = "Dept2"
    arrNames(9) = "ID"
    arrNames(10) = "Num/account"
    arrNames(11) = "Name account"
    arrNames(12) = "Sum1"
    arrNames(13) = "Sum2"
    arrNames(14) = "Date2"
    arrNames(15) = "Status"
    arrNames(16) = "Year"
    arrNames(17) = "Num/account2"
    arrNames(18) = "Name_dept"
    arrNames(19) = "Events"
    arrNames(20) = "Comments"
  
    Dim i As Long
    Dim findValue As Variant
    Dim headerCell As Range
    Dim iNum As Long
   
    Dim lFirstRow As Long
    lFirstRow = 2
   
    For i = LBound(arrNames) To (UBound(arrNames) - 1)
        findValue = arrNames(i)
        iNum = iNum + 1
        Set headerCell = ActiveSheet.Rows(lFirstRow).Find(What:=findValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not headerCell.Column = iNum Then
            Columns(headerCell.Column).Cut
            Columns(iNum).Insert Shift:=xlToRight
        End If
    Next i
End Sub

The arrays have 21 and 20 elements. For current problem the field "View1" dont using

Thanks
 
Upvote 0
For Non-VBA solution if you prefer follow the below steps. It will be very fast.

1. Select your range
2. Click Sort------->Options-------->Sort Left to Right---------->Ok
3. Sort by--------->Row1
4. Order----------->CustomLists

Now type your header names of columns in List entries Box in your desired order separated by comma like Dept,View2,Name, and so on.

5. Click Add
6. Click Ok
 
Upvote 0
Give this macro a try (I think you will be please by its speed... little more than 2 seconds to process 44,000 rows of data on my computer)...
Code:
[table="width: 500"]
[tr]
	[td]Sub RearrangeColumns()
  Dim LastRow As Long, NewOrder As Variant
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  NewOrder = Split("1,20,6,21,22,3,4,5,19,7,8,9,10,11,12,13,14,15,16,17,18", ",")
  Range("A1").Resize(LastRow, UBound(NewOrder) + 1) = Application.Index(Cells, Evaluate("ROW(1:" & LastRow & ")"), NewOrder)
  Columns("V").Clear
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Oops. The field Num/Account changed format.

For example value in cell
was 91234560607890114563 and now 91234560600000000000

Is that possible to modify that sub RearrangeColumns without changing format ?
Thanks
 
Upvote 0

Forum statistics

Threads
1,214,321
Messages
6,118,886
Members
448,856
Latest member
Eduard_Stoo

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