Sorting data by column values using Excel VBA, descending and ascending

Question

I have been working on a VBA macro that exports the values of a unit vector for each selected line in the SolidWorks interface, and I want to sort the value of the unit vector before it is written to Excel. I need to sort the Excel range B2 to D2 (B2 representing part i of the unit vector, C2 representing part j, and D2 representing part k), and the range depends on the number of selected lines. Each selected line represents a vector, and each vector represents a row in Excel.

I want to sort them by column D, and then I want to sort them with the maximum value in cell D2, the minimum value in cell D3, and have it go ascending from there. It would be ascending first, then descending from the second row down.

So if there were four selected lines, the D column would look like this:

-0.99221 -1 -0.99789 -0.99664

Currently it looks like this:

Excel screenshot

But it would not know how many rows that needed to be sorted at first. Here is the relevant code:

Dim r As Long
Dim ws As Worksheet
Set ws = ActiveSheet

For q = 3 To NumberOfSelectedItems
Columns("B:D").Sort key1:=Range("D2:D2"), order1:=xlDescending, Header:=xlYes
r = ws.Cells(ws.Rows.Count, 4).End(xlUp).Rows
Range("B3:D2" & r).Sort key1:=Range("D2:D2"), order1:=xlAscending, Header:=xlNo
bRes = WriteToExcel(((q - 1) * 1) + 1, vModelSelPt4, "Unit Vector")
Next

Currently, the code gives me the 1004 error. I think it's something small that's wrong but am not sure. How do I order it by D column in the order described above?

Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean

    'get the results into excel

    With xlWorkbook.ActiveSheet
        .Cells(startRow + 2, 2).Value = data(0)
        .Cells(startRow + 2, 3).Value = data(1)
        .Cells(startRow + 2, 4).Value = data(2)
    End With
End Function

The above code is the function for writing the data to Excel; it is very relevant. This is all done in SolidWorks API so the syntax is a bit different.

Answer 1

None of the posted lines in your question were giving me any error except for the line with your custom function WriteToExcel (which you didn't include in your code sample and I therefore deem irrelevant).

So, unless you have an error in this function, the above code should work flawlessly.

For the sorting I'd recommend that you sort column D ascending and then move the row of the sorted table (with the maximum in column D) from the bottom of the table to the top. The following sub does just that:

Option Explicit

Public Sub SortIt()

Dim lngLastRow As Long

With ThisWorkbook.Worksheets(1)
    lngLastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("D2:D" & lngLastRow), _
            SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange Range("A1:D" & lngLastRow)
        .Header = xlYes
        .Apply
    End With
    .Range("A2:D" & lngLastRow).Copy Destination:=Range("A3")
    .Range(.Cells(lngLastRow + 1, 1), .Cells(lngLastRow + 1, 4)).Cut _
        Destination:=Range("A2")
End With

End Sub

Note, that the above code assumes the table to be on sheet 1. If that's not the case then you should adjust the code. Let me know if you have any questions or it there are any problems.

Edit: Changed Copy command to Cut.