how to rearrange columns quickly

[vics_roo]

Hi,

I need to rearrange columns. I do that by following 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

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

 

[yky]

Try this:

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

 

[vics_roo]

Try this:

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]

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.

 

[Rick Rothstein]

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]

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

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

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]

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]

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)...

[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]

 

[vics_roo]

Thank you for your reply.

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

 

[vics_roo]

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