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

 

[Rick Rothstein]

My worksheet have ListObj table - MyData.

Well, that is the first mention of an important piece of information.

The first row is not belong MyData table.
The second line is headers MyData table.

Okay, if the first row is not part of the Table object, should they still be moved with the Table's columns or left alone as is?

Other lines - there are data

When you say "other lines", do you mean rows of data located below the Table object which should not be moved?

 

[vics_roo]

Yes, first row must be moved with the Table's columns

Other lines - I mean Table's data.

 

[vics_roo]

So can I do rearrange my columns without Unlist and Add MyData Table ?

ActiveSheet.ListObjects("MyData").Unlist

Rows(1).Insert
Range("A1:V1").Value = Array(1, 20, 19, 21, 22, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18)
'Range("A1:V1").Value = Array(2, 1, 20, 6, 21, 22, 3, 4, 5, 19, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18)
Range("A1:V" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Range("A1"), xlAscending, Orientation:=xlSortRows
'Rows(1).Delete: Columns(1).Delete
Rows(1).Delete
 
  ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(2, 1), Cells(getLastRow("A"), getLastColumn("A", 2))), , xlGuess, xlNo).Name = "MyData"
  ActiveSheet.ListObjects("MyData").TableStyle = "TableStyleLight14"