Sort range without sorting it in a spreadsheet - vba

Question

Question is about sorting data in VBA. Suppose I have a Range("A1:A10") which I want to sort in ascending order. However, I do not want any changes in my spreadsheet (so all the calculations are made within a VBA code). The output of the operation should be a NewRange where all the numbers are sorted.
Has someone ideas about this problem?

Answer 1

Here is a very simple little routine to sort a two-dimensional array such as a range:
Option Base 1
Option Explicit
Function SortThisArray(aryToSort)
Dim i As Long
Dim j As Long
Dim strTemp As String
For i = LBound(aryToSort) To UBound(aryToSort) - 1
For j = i + 1 To UBound(aryToSort)
If aryToSort(i, 1) > aryToSort(j, 1) Then
strTemp = aryToSort(i, 1)
aryToSort(i, 1) = aryToSort(j, 1)
aryToSort(j, 1) = strTemp
End If
Next j
Next i
SortThisArray = aryToSort
End Function
How to use this sort function:
Sub tmpSO()
Dim aryToSort As Variant
aryToSort = Worksheets(1).Range("C3:D9").Value2 ' Input
aryToSort = SortThisArray(aryToSort) ' sort it
Worksheets(1).Range("G3:H9").Value2 = aryToSort ' Output
End Sub
Notes:
The range sorted here is on Worksheet(1) in the Range("C3:D9") and the output is going on the same sheet into Range("G3:H9")
The range will be sorted in ascending order.
The range will be sorted based on the first column (here column C). If you wish to sort for another column then you just have to change all the aryToSort(i, 1) and aryToSort(j, 1) to which ever column you wish to sort. For example by column 2: aryToSort(i, 2) and aryToSort(j, 2).
UPDATE:
If you prefer to use the above as a function then this is also possible like this:
Option Base 1
Option Explicit
Function SortThisArray(rngToSort As range)
Dim i As Long
Dim j As Long
Dim strTemp As String
Dim aryToSort As Variant
aryToSort = rngToSort.Value2
For i = LBound(aryToSort) To UBound(aryToSort) - 1
For j = i + 1 To UBound(aryToSort)
If aryToSort(i, 1) > aryToSort(j, 1) Then
strTemp = aryToSort(i, 1)
aryToSort(i, 1) = aryToSort(j, 1)
aryToSort(j, 1) = strTemp
End If
Next j
Next i
SortThisArray = aryToSort
End Function
And this is how you would use the function:

Answer 2

This is just a sample that you may adapt to your needs, it uses B11:B20 as NewRange:
Sub SortElseWhere()
Dim A As Range, NewRange As Range
Set A = Range("A1:A10")
Set NewRange = Range("B11:B20")
A.Copy NewRange
NewRange.Sort Key1:=NewRange(1, 1), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
The original cells are not sorted, they are merely copied to another location which is sorted.
EDIT#1:
In this version, NewRange is not a range of cells, but an internal array:
Sub SortElseWhere2()
Dim A As Range, NewRange(1 To 10) As Variant
Dim i As Long, strng As String
i = 1
Set A = Range("A1:A10")
For Each aa In A
NewRange(i) = aa
i = i + 1
Next aa
Call aSort(NewRange)
strng = Join(NewRange, " ")
MsgBox strng
End Sub
Public Sub aSort(ByRef InOut)
Dim i As Long, J As Long, Low As Long
Dim Hi As Long, Temp As Variant
Low = LBound(InOut)
Hi = UBound(InOut)
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
For i = Hi - J To Low Step -1
If InOut(i) > InOut(i + J) Then
Temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = Temp
End If
Next i
J = J \ 2
Loop
End Sub

Answer 3

Here I am submitting slightly different sort routine.It sorts the 2nd column first then 1st column.
Function BubbleSort(TempArray() As Variant, SortIndex As Long)
Dim blnNoSwaps As Boolean
Dim lngItem As Long
Dim vntTemp(1 To 2) As Variant
Dim lngCol As Long
Do
blnNoSwaps = True
For lngItem = LBound(TempArray) To UBound(TempArray) - 1
If TempArray(lngItem, SortIndex) > TempArray(lngItem + 1, SortIndex) Then
blnNoSwaps = False
For lngCol = 1 To 2
vntTemp(lngCol) = TempArray(lngItem, lngCol)
TempArray(lngItem, lngCol) = TempArray(lngItem + 1, lngCol)
TempArray(lngItem + 1, lngCol) = vntTemp(lngCol)
Next
End If
Next
Loop While Not blnNoSwaps
End Function
Sub Test()
Dim vntData() As Variant
vntData = range("C3:D9")
BubbleSort vntData, 2
BubbleSort vntData, 1
range("G3:H9") = vntData
End Sub
Results obtained from this routine are shown below.