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]

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 ?

Is that the only field that was affected? In particular, what about the Date, Date2, Sum1 or Sum2 fields... did they change?

 

[Rick Rothstein]

Is that the only field that was affected? In particular, what about the Date, Date2, Sum1 or Sum2 fields... did they change?

As a follow-up to the above question... I need to know the Number Format for each column of your original data (before my code moves them) and if any have a Custom Format, I need to know what that custom format is. You can "Reply With Quote" and write them after the dash on each line below...

№s/r -
View1 -
DC2 -
Group -
Curr -
Dept -
ID -
Num/account -
Nameaccount -
Sum1 -
Sum2 -
Date2 -
Status -
Year -
Num/account2 -
Name_dept -
Events -
Comments -
Dept2 -
Date -
View2 -
Name -

 

[vics_roo]

Here is formats before arrangeColumns

№s/r - View1 - DC2 - Group - Curr - Dept - ID - Num/account - Nameaccount - Sum1 - Sum2 - Date2 - Status - Year - Num/account2 - Name_dept - Events - Comments - Dept2 - Date - View2 - Name -

General General General #00 Numeric #0000 Numeric General General #0.00 #0.00 *dd.mm.yyyy General *dd.mm.yyyy General General General General General General General General

<tbody>
</tbody>

 

[Rick Rothstein]

Here is formats before arrangeColumns

№s/r - View1 - DC2 - Group - Curr - Dept - ID - Num/account - Nameaccount - Sum1 - Sum2 - Date2 - Status - Year - Num/account2 - Name_dept - Events - Comments - Dept2 - Date - View2 - Name -

General General General #00 Numeric #0000 Numeric General General #0.00 #0.00 *dd.mm.yyyy General *dd.mm.yyyy General General General General General General General General

<tbody>
</tbody>

Please clarify...

1) Your Group, Dept, Sum1 and Sum2 are Custom Formatted to have a # sign in front of each of their values?

2) Your Date column is Formatted as General?

3) Your Date2 is Custom Formatted to have an asterisk (*) in front and the delimiter is a dot?

4) Your Year is Formatted the same as Date2?

5) You Curr and ID columns are formatted as Numeric... did you mean as Number with 0 decimal places?

Also, you did not answer if other columns changed after my code moved them?

 

[Ombir]

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

Have you tried what I suggested in Post 7. If not, then this VBA alternative for that. It won't mess up with your Cell Formatting and also Pretty fast.

Sub Rearrange()
    Rows(1).Insert
    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 Key1:=Range("A1"), Order1:=xlAscending, Orientation:=xlSortRows
    Rows(1).Delete: Columns(1).Delete
End Sub

 

[vics_roo]

Yes, the some columns were changed, but I fixed columns by the following function.
Only "Num/account" and "Num/account2" not repaired

Sub doFormat()
    
    Dim rng As Range
    Dim rCell As Range
    
    Dim lastRow As Long
    lastRow = getLastRow("A")
    
    Set rng = ActiveSheet.Range("A3:A" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("B3:B" & lastRow)
    rng.NumberFormat = "m/d/yyyy"
    
    Set rng = ActiveSheet.Range("C3:C" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("D3:D" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("E3:E" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("F3:F" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("G3:G" & lastRow)
    rng.NumberFormat = "#0000"
   
    Set rng = ActiveSheet.Range("H3:H" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("I3:I" & lastRow)
    rng.NumberFormat = "#0000"
    
    Set rng = ActiveSheet.Range("J3:J" & lastRow)
    rng.NumberFormat = "@"
    
    'Num/account
    Set rng = ActiveSheet.Range("K3:K" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("L3:L" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("M3:M" & lastRow)
    rng.NumberFormat = "#0.00"
    
    Set rng = ActiveSheet.Range("N3:N" & lastRow)
    rng.NumberFormat = "#0.00"
    
    Set rng = ActiveSheet.Range("O3:O" & lastRow)
    rng.NumberFormat = "m/d/yyyy"
    
    Set rng = ActiveSheet.Range("P3:P" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("Q3:Q" & lastRow)
    rng.NumberFormat = "m/d/yyyy"
    
    'Num/account2
    Set rng = ActiveSheet.Range("R3:R" & lastRow)
    rng.NumberFormat = "General"
    
    Set rng = ActiveSheet.Range("S3:S" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("T3:T" & lastRow)
    rng.NumberFormat = "@"
    
    Set rng = ActiveSheet.Range("U3:U" & lastRow)
    rng.NumberFormat = "@"
    
End Sub

 

[Rick Rothstein]

Use Ombir's code from Message #15 instead of mine, but with the changes I added (shown in red) below..

[table="width: 500"]
[tr]
	[td]Sub Rearrange()
  [B][COLOR="#FF0000"]Application.ScreenUpdating = False[/COLOR][/B]
  Rows(1).Insert
  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
  [B][COLOR="#FF0000"]Application.ScreenUpdating = True[/COLOR][/B]
End Sub[/td]
[/tr]
[/table]

 

[vics_roo]

Use Ombir's code from Message #15 instead of mine, but with the changes I added (shown in red) below..

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub Rearrange()
  [B][COLOR=#FF0000]Application.ScreenUpdating = False[/COLOR][/B]
  Rows(1).Insert
  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
  [B][COLOR=#FF0000]Application.ScreenUpdating = True[/COLOR][/B]
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Sort method of Range class failed on that line

Range("A1:V" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Range("A1"), xlAscending, Orientation:=xlSortRows

[h=2][/h]

 

[Rick Rothstein]

Sort method of Range class failed on that line

Range("A1:V" & Cells(Rows.Count, 1).End(xlUp).Row).Sort Range("A1"), xlAscending, Orientation:=xlSortRows

[h=2][/h]

Hmm! I am not sure what to tell you... the code worked perfectly for me on my constructed sample of 40,000+ rows. Is that anyway you can post a copy of your original data (before any code runs on it) to OneDrive, DropBox or some other file sharing facility so that we can debug your actual data/layout instead of made up data? Remember to change sensitive information before posting (best is to put something like A1 in the first cell and copy it down). Also, if you do change sensitive information, test the code against that modified data to make sure it still doesn't work. If it still doesn't work, make you post the modified file as it existed before you ran the code against it.

 

[vics_roo]

Seems I understood about this error. My worksheet have ListObj table - MyData. Seems it's break Ombir's code.

There is fragment of my worksheet (I show only 5 columns)

1	2	3	4	5
№s/r (header)	View1(header)	DC2(header)	Group(header)	Curr(header)
345	viewItem1	dc1	gr_type1	300.07
27	viewItem2	dc2	gr_type2	1.00

<tbody>
</tbody>

The first row is not belong MyData table.
The second line is headers MyData table.
Other lines - there are data

So how to modify Ombir's code if I have ListObj table ?

regards