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

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,880
Office Version
  1. 2010
Platform
  1. Windows
Try this:

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

vics_roo

Board Regular
Joined
Apr 3, 2015
Messages
75
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.:(
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
18,688
Office Version
  1. 2013
Platform
  1. Windows
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:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,873
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

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.
 

vics_roo

Board Regular
Joined
Apr 3, 2015
Messages
75
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
 

Ombir

Active Member
Joined
Oct 1, 2015
Messages
433

ADVERTISEMENT

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
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,873
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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:

vics_roo

Board Regular
Joined
Apr 3, 2015
Messages
75
Thank you for your reply.

It's really working quickly now - 7 seconds instead 17 minutes
 

vics_roo

Board Regular
Joined
Apr 3, 2015
Messages
75
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,836
Messages
5,833,904
Members
430,242
Latest member
Bancam

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
Top