Sort range without sorting it in a spreadsheet

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

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 2

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:

1. 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")
2. The range will be sorted in ascending order.
3. 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 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.