VBA to sort columns from smallest to largest...

[Yamasaki450]

Hello VBA experts.

I need two VBA codes to sort columns from smallest to largest and largest to smallest. Like shown on screenshots bellow.
I have quite large amount of data to sort (15315 columns) so VBA code needs to be reasonably fast. My data goes from L14 to VQX1630.
Is anyone able to write this for me? Writing VBAs its a bit too much for me...

Thanks guys...

 

[sxhall]

Hi Yamasaki450,

Code below will...

• will run on the sheet you have selected.
• run on the range L14:VQX1630.
• sort small to large or large to small.
• align all values to the bottom of range as in your example.

You will need to choose the option in the code for ascending or descending where indicated below. Basically add/remove the ' against the option you don't want. It is set to sort descending at the minute.

I set up a full size test and my (sluggish!) laptop took 37 seconds to complete the task. May be quicker ways but this will get you to what you need

Sub SortValues()

Dim rng As Range
Dim SortSeq As String
Dim SortArea As Range
Dim FRow As Integer
Dim LRow As Long
Dim ActSheet As Worksheet

Set ActSheet = ActiveSheet
Set SortArea = Range("L14:VQX1630")

Application.ScreenUpdating = False

FRow = SortArea.Row
LRow = SortArea.Rows.Count + x

For Each rng In SortArea.Columns

rng.Select

ActSheet.Sort.SortFields.Clear
'*** Choose the option you want here, ascending or descending ***
'    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlAscending
    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlDescending
    
    With ActSheet.Sort
        .SetRange rng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

If LRow - Application.WorksheetFunction.CountA(rng) > 0 Then
    Cells(FRow, rng.Column).Resize(LRow - Application.WorksheetFunction.CountA(rng), 1).Insert Shift:=xlDown
End If
    
Next rng

Application.ScreenUpdating = True

End Sub

Code set for ascending...

    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlAscending
'    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlDescending

 

[Yamasaki450]

Sub SortValues()

Dim rng As Range
Dim SortSeq As String
Dim SortArea As Range
Dim FRow As Integer
Dim LRow As Long
Dim ActSheet As Worksheet

Set ActSheet = ActiveSheet
Set SortArea = Range("L14:VQX1630")

Application.ScreenUpdating = False

FRow = SortArea.Row
LRow = SortArea.Rows.Count + x

For Each rng In SortArea.Columns

rng.Select

ActSheet.Sort.SortFields.Clear
'*** Choose the option you want here, ascending or descending ***
'    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlAscending
    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlDescending
   
    With ActSheet.Sort
        .SetRange rng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

If LRow - Application.WorksheetFunction.CountA(rng) > 0 Then
    Cells(FRow, rng.Column).Resize(LRow - Application.WorksheetFunction.CountA(rng), 1).Insert Shift:=xlDown
End If
   
Next rng

Application.ScreenUpdating = True

End Sub

Code set for ascending...

    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlAscending
'    ActSheet.Sort.SortFields.Add2 Key:=rng, Order:=xlDescending

Thanks man...

There is a little problem i have...

This VBA works very fast if there is no empty or half empty columns in range. It sorts 15315 columns in 30 seconds.

But if there are empty and half empty columns included it takes very long time to process... I waited 30 minutes but still didnt finish. Big difference.

I uploaded two worksheets on google drive so you can test it yourself if you want.

First one with no empty and half empty columns (VBA works very fast)
Worksheet 1

Second one with couple of empty columns and a lot of half empty columns ( VBA works very slow)
Worksheet 2


Can this be fixed so it works fast with empty and half empty columns included in range?
Data range is the same in both L14:VQX1630

 

[Akuini]

@Yamasaki450
Try this:

Sub Yamasaki450_1()

Dim i As Long, j As Long
Dim t As Double, va
Application.ScreenUpdating = False
t = Timer
va = Range("A1:VQX1630")  'data in L14:VQX1630

For j = 12 To UBound(va, 2) 'data start at col 12
    For i = 14 To UBound(va, 1) 'data start at row 14
        If va(i, j) <> "" Then
                With Range(Cells(i, j), Cells(1630, j))
                    .Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
                End With
                Exit For
        End If
    Next
Next
Application.ScreenUpdating = True
Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

 

[Yamasaki450]

@Yamasaki450
Try this:

Sub Yamasaki450_1()

Dim i As Long, j As Long
Dim t As Double, va
Application.ScreenUpdating = False
t = Timer
va = Range("A1:VQX1630")  'data in L14:VQX1630

For j = 12 To UBound(va, 2) 'data start at col 12
    For i = 14 To UBound(va, 1) 'data start at row 14
        If va(i, j) <> "" Then
                With Range(Cells(i, j), Cells(1630, j))
                    .Sort Key1:=.Cells(1), Order1:=xlDescending, Header:=xlNo
                End With
                Exit For
        End If
    Next
Next
Application.ScreenUpdating = True
Debug.Print "Completion time:  " & Format(Timer - t, "0.00") & " seconds"
End Sub

Thanks this works now. It sorts all 15315 columns instantly.

But now i have another problem heh... If only one workbook is open this macro works just fine. But if there is another workbook opened in background this macro wont work.
It just says running and constant screen blinking... Any idea why is this happening? Any other macro i used so far dont have this problem.

Not a big deal but sometimes is annoying...

 

[Akuini]

Any idea why is this happening? Any other macro i used so far dont have this problem.

Sorry, no idea.
Is it different if you try it with fewer columns, say only 100 columns?

 

[Yamasaki450]

Sorry, no idea.
Is it different if you try it with fewer columns, say only 100 columns?

I tested it and it works fine with only 100 columns.

 

[Akuini]

But if there is another workbook opened in background this macro wont work.
It just says running and constant screen blinking...

I'm not sure why you're experiencing that issue. When I ran the code on the whole data (in worksheet2 of post 3), with another workbook open, I didn't encounter any problems. It completed in just 14 seconds.

 

[Yamasaki450]

I'm not sure why you're experiencing that issue. When I ran the code on the whole data (in worksheet2 of post 3), with another workbook open, I didn't encounter any problems. It completed in just 14 seconds.

Its ok. Thanks for your help and have a nice day...

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.