Reorder columns - Faster way with Array

[SidKol]

Hi,

I have a working VBA-code for reordering columns alphabetically.
Only problem: the sheet is so big that it takes over 20 minutes to complete.

[COLOR=Navy]Sub[/COLOR] OrderColumnsAZ()
[COLOR=Navy]Dim[/COLOR] rng [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] i [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] J [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Temp
[COLOR=Navy]Set[/COLOR] rng = Range("A1").CurrentRegion
[COLOR=Navy]For[/COLOR] i = 1 To rng.Columns.Count
    [COLOR=Navy]For[/COLOR] J = i To rng.Columns.Count
        [COLOR=Navy]If[/COLOR] rng(J) < rng(i) [COLOR=Navy]Then[/COLOR]
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] J
[COLOR=Navy]Next[/COLOR] i
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Recently I had a similar problem, which (thanks to macleanb and JackDanIce) could be solved by "assigning the value2 property of the usedrange to an array, iterating around the array and then putting in back once all replacements are done. "
Link: http://www.mrexcel.com/forum/excel-questions/894230-replace-blanks-big-sheet-fastest-way.html

I have tried to use this feedback in the code, but can't get it right.
The code that I have now (see underneath) actually does nothing anymore (also no error message)
Hopefully somebody can help me to integrate the array-part in the code above correctly.

Sub OrderColumnsAZ()

Dim rng As Range
Dim i As Integer
Dim J As Integer
Dim Temp
Dim arr() As Variant

With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With

With Sheets("NEW")

[COLOR=Navy]Set[/COLOR] rng = Range("A1").CurrentRegion
  arr = .Range(.Cells(1, 1), rng).Value2

For i = 1 To rng.Columns.Count
    For J = i To rng.Columns.Count
        If rng(J) < rng(i) Then
            Temp = rng.Columns(i).Value
            rng(i).Resize(rng.Rows.Count) = rng.Columns(J).Value
            rng(J).Resize(rng.Rows.Count) = Temp
        End If
    Next J
Next i

  .Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr

End With

Erase arr
Set rng = Nothing

With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
End With

End Sub

 

[Jonmo1]

Here's an outside the box thought, and I haven't put it in code yet...

You can SORT a range by row (transposed of a normal sort)
If you add a helper ROW, and number the columns in the order you want them.
Then Sort the range, click the options button in the sort window and select 'left to right'
Then sort by the helper row in ascending order.

And actually, according to the code you posted it looks like you already have a row setup for the sorting...

 

[SidKol]

Hi Jonmo1,

Thanks for your reply.
I already have a working code.
Only problem is that the code is extremely slow.

I know that using an array kan speed up things.
As it can load the worksheet into an array kept in the PC's memory.
This way data can be processed faster than when the code has to interact with the worksheet

Therefore I am looking to integrate this in the first code.

 

[JoeMo]

Hi Jonmo1,

Thanks for your reply.
I already have a working code.
Only problem is that the code is extremely slow.

I know that using an array kan speed up things.
As it can load the worksheet into an array kept in the PC's memory.
This way data can be processed faster than when the code has to interact with the worksheet

Therefore I am looking to integrate this in the first code.

You can put the values in rng into an array and then bubble sort the array, but I wonder if that would be faster than Jonmo1's proposal. Here's Jonmo1's approach coded as best I can understand what you want to do. Try it on a copy of your sheet to see if its any faster.

Sub OrderColumnsAZ()
Dim rng As Range
Set rng = Range("A1").CurrentRegion
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
rng.Sort key1:=rng.Rows(1), order1:=xlAscending, Header:=xlGuess, Orientation:=xlSortRows
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With
End Sub

 

[SidKol]

Now that actually works perfect.
In fact it's not even really needing the xlCalculationManual.
Tried it without just to see the difference, but still works extremely fast.

Unbelievable to see that this could be just fixed with a single line of code.

Thank you very much Jonmo1 and JoeMo!

 

[Jonmo1]

You're welcome.

And thanks for putting it into code Joe.

 

[JoeMo]

Now that actually works perfect.
In fact it's not even really needing the xlCalculationManual.
Tried it without just to see the difference, but still works extremely fast.

Unbelievable to see that this could be just fixed with a single line of code.

Thank you very much Jonmo1 and JoeMo!

Code that works and is essentially a single line is a very rare event for me - I tend to code verbosity! Jonmo1 did all the heavy lifting on this one with his usual creativity!