how to rearrange columns quickly

vics_roo

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

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

yky

Well-known Member
Joined
Jun 7, 2011
Messages
1,872
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
72
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
17,597
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
36,981
Office Version
  1. 2016
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
72
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
36,981
Office Version
  1. 2016
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
72
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
72
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,307
Messages
5,641,440
Members
417,209
Latest member
Agbarker

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