VBA Excel: sorting arrays

andy7789
andy7789 used Ask the Experts™
on
Hi X-perts,

I have two arrays:

names(1 to 20) ---- a string array
values(1 to 20) ----- a numerical array (double)

Both arrays are linked, i.e. i-th element of names corresponds to i-th element of values.

I need to sort both arrays on values, i.e. after sorting the 2nd array (values) will have all decrementing values and its i-th element will correspond to the same name as before sorting (i-th element of names)

Please suggest the most elegant way of doing that.

Thanks
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Expert of the Quarter 2010
Expert of the Year 2010

Commented:
Put them into two columns.
Select all 40 cells.
From the menu/ribbon, choose Sort, or use the keyboard - Alt-D, Alt-S
Options: no header, column (choose the column containing the values)

Author

Commented:
I need a VBA solution. Something like the attached code, but with a better performance
Public Function SortArray(ByRef TheArray As Variant)
Sorted = False
Do While Not Sorted
    Sorted = True
For X = 0 To UBound(TheArray) - 1
    If TheArray(X) > TheArray(X + 1) Then
        Temp = TheArray(X + 1)
        TheArray(X + 1) = TheArray(X)
        TheArray(X) = Temp
        Sorted = False
    End If
Next X
Loop
End Function

Open in new window

Expert of the Quarter 2010
Expert of the Year 2010
Commented:
I don't know about better.. but use Excel's built in sorter.
Public Sub SortArray(ByRef TheArray As Variant, ByRef TheOtherArray As Variant)
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets.Add
ws.Range("A1:A10").Value = WorksheetFunction.Transpose(TheArray)
ws.Range("B1:B10").Value = WorksheetFunction.Transpose(TheOtherArray)
ws.Range("A1:B10").sort ws.Range("B1"), xlAscending

TheArray = WorksheetFunction.Transpose(ws.Range("A1:A10"))
TheOtherArray = WorksheetFunction.Transpose(ws.Range("B1:B10"))

Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Open in new window

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial