advenced sort by calculation result - VBA

[zico8]

Hi,

I need your help to find any idea how to handle the task.

Let's say - I have the sheet with 500 rows (from the top) where column A contains Name and column B and column C contain some numbers.

row1: name1, 2, 3,
row2: name2, 1, 1,
row3: name3, 3, 1,
row4: name4, 2, 4,
and so on.

I need to sort these rows that way so the total sum of (column B - Column C) * Row() will be the lowest.

In the case above the correct result is:
row1: name3, 3, 1,
row2: name2, 1, 1,
row3: name1, 2, 3,
row4: name4, 2, 4,

The result is:
(3-1)*1+(1-1)*2+(2-3)*3+(2-4)*4 = -9 and will not be lowest in any of other sorting.

How to do it by VBA?
The result can be calculated by formula in the sheet or inside in the macro.

Is it possible to do it so the executing macro will not take whole day??

 

[DataBlake]

Hi,

I need your help to find any idea how to handle the task.

Let's say - I have the sheet with 500 rows (from the top) where column A contains Name and column B and column C contain some numbers.

row1: name1, 2, 3,
row2: name2, 1, 1,
row3: name3, 3, 1,
row4: name4, 2, 4,
and so on.

I need to sort these rows that way so the total sum of (column B - Column C) * Row() will be the lowest.

In the case above the correct result is:
row1: name3, 3, 1,
row2: name2, 1, 1,
row3: name1, 2, 3,
row4: name4, 2, 4,

The result is:
(3-1)*1+(1-1)*2+(2-3)*3+(2-4)*4 = -9 and will not be lowest in any of other sorting.

How to do it by VBA?
The result can be calculated by formula in the sheet or inside in the macro.

Is it possible to do it so the executing macro will not take whole day??

the only way i would think to do this without actually calculating all 500 rows would be to sort column B by smallest value and then column C by largest value

Sub Macro1()
Dim lastRow As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row

    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B" & lastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C" & lastRow) _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:C" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

see if it works
change "Sheet1" to whatever your sheet name is called