Frontier Line!!! Please help with macro

[j33pguy]

hi,
i have 5000 lines of Risk versus Cost data....
column A is 1-5000
column B is Risk numbers
Column C is cost numbers

what i need to figure out how to do is graph the frontier line (optimal line) through these points! any ideas as what macro i would need?

 

[colbymack]

I am not sure if this is the same as what you are looking for, but if you right click on the chart (I think you have to do it on one of the charted items (i.e. on a bar within a bar graph), you can add a Trendline. You can also display the formula for that trendline.

HTH,
Colbymack

 

[j33pguy]

no, that's not what i need.
i just wrote this macro....it seems to do what i need....but it's very slow....
any ideas as how to make it faster?
i would appreciate any help!

Sub Macro1()

   XX = 0
   Do Until XX = 30

   Application.ScreenUpdating = False
    Range("A3:C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Sort Key1:=Range("B3"), Order1:=xlDescending, Key2:=Range("C3") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>=R[1]C[-1],0,1)"
    Range("D3").Select
    Selection.Copy
    Range("D4").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A3:D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.LargeScroll Down:=-1
    Range("D5939").Select
    Selection.End(xlUp).Select
    Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("E3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3:E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
       JJ = 3
    Do Until Range("E" & JJ) = 1
    If Range("E" & JJ) = 0 Then
    Range("E" & JJ).Select
    Selection.EntireRow.Delete
    JJ = JJ + 1
    
    End If
    
    Loop
    
    XX = XX + 1
    Loop
    Application.ScreenUpdating = True
End Sub

 

[colbymack]

If you haven't already done so, check out the post by Buffalo titled

excel program for the "critical line algorithm"?

It has some links that might be useful.

 

[Joe4]

Regarding speeding up your code, you have a lot of unnecessary Select statements in your code. Selecting ranges slows down your code, and most of the time it is not necessary to select them to work on them.

Here are some examples in your code where you can get rid of Select statements and combine two lines of code into one:

Range("D3").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>=R[1]C[-1],0,1)"
becomes
Range("D3").FormulaR1C1 = "=IF(RC[-1]>=R[1]C[-1],0,1)"

Range("D3").Select
Selection.Copy
becomes
Range("D3").Copy

Range("D5939").Select
Selection.End(xlUp).Select
becomes
Range("D5939").End(xlUp).Select

Range("E" & JJ).Select
Selection.EntireRow.Delete
becomes
Range("E" & JJ).EntireRow.Delete

 

[Von Pookie]

Please see:
http://www.mrexcel.com/board2/viewtopic.php?t=183156