Sort an array in VBA

[UnsolvedCoding]

I searched all over to find a simple way to sort an array in VBA. This sub works but keep in mind that this array is determined by having your selection highlighted before running the sub and will put the sorted information back into the portion you selected at the end of the sort.

If you want to do a different array you will need to set up your redim preserve statments since they are not included.


Sub Sort_Array()

Dim sortingArray As Variant
Dim i As Long
Dim j As Long
Dim temp As Variant

' Create Array
sortingArray = Selection.Value

For i = 1 To (UBound(sortingArray, 1) - 1)

For j = i To UBound(sortingArray, 1)

If Val(sortingArray(j, 1)) < Val(sortingArray(i, 1)) Then
temp = sortingArray(i, 1)
sortingArray(i, 1) = sortingArray(j, 1)
sortingArray(j, 1) = temp
End If

Next j

Next i

' Place array
Selection.Value = sortingArray

End Sub

 

[UnsolvedCoding]

This is a sub I use to sort workbook tabs in ascending order. Its not elegent but it works.

Note that the warning is left on so that you can keep or delete the sheet holding information.

Option Explicit

Sub Sort_Tabs()

Dim Test As String
Dim Number_Test As Integer
Dim sSheetName
Dim WS_Count As Integer
Dim J As Integer
Dim I As Integer

' Create a worksheet to use
Sheets.Add after:=Sheets(Sheets.Count)

' Get the new worksheets name
sSheetName = ActiveSheet.Name

' Count the work sheets
WS_Count = Application.Sheets.Count

' Loop through all of the worksheets in the active workbook.
' Begin the loop.
For J = 1 To WS_Count

' Create list of worksheet names
Worksheets(sSheetName).Range("A" & J + 1).Value = Worksheets(J).Name

Next J

' Sort the info through row 1000
ThisWorkbook.Worksheets(sSheetName).Columns("A:A").Select
ThisWorkbook.Worksheets(sSheetName).Sort.SortFields.Clear
ThisWorkbook.Worksheets(sSheetName).Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ThisWorkbook.Worksheets(sSheetName).Sort
.SetRange Range("A2:A1000")
.Header = xlNo
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

J = 2

Do
' Capture the worksheet number
Worksheets(sSheetName).Range("B" & J).Value = J - 1
J = J + 1

Loop Until Trim(Worksheets(sSheetName).Range("A" & J).Value) = ""

' Start looping through workbook
For J = 1 To WS_Count

'Clear Variables
Test = ""
Number_Test = 0

' Get the last worksheet name
Test = Trim(Worksheets(sSheetName).Range("A" & J + 1).Value)

' Get the number of the worksheet position in the workbook
Number_Test = Trim(Worksheets(sSheetName).Range("B" & J + 1).Value)

' This addresses the chance that the first tab is in the correct location
If J = 1 And UCase(Worksheets(J).Name) = UCase(Test) Then
GoTo A
End If

I = J

Do

If UCase(Worksheets(I).Name) = UCase(Test) Then
' Move the worksheet to follow the last worksheet
Worksheets(I).Move after:=Worksheets(Number_Test - 1)
GoTo A
End If

I = I + 1

Loop Until I > WS_Count


A:

Next J

Worksheets(sSheetName).Delete

Application.DisplayAlerts = True


Exit Sub

Error_Handler:

msgbox "Uh-oh"

End Sub