Hi,
I need to rearrange columns. I do that by following code
The problem the code working slowly if i have 40000 rows or more...
I checked it by
The value Here is 965.56
So how i can do that more quick ?
Thanks
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)
So how i can do that more quick ?
Thanks
Last edited: