Macro help! Please!

[j33pguy]

Any help would be appreciated

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

 

[Seti]

So are you trying to find the greatest cost for each risk point?

 

[j33pguy]

nope. lowest cost for each lowest risk.

basically, have lowest risk with the lowest cost!

 

[Seti]

I have to run, but I'll think about this some more. Could you post a simple chunk of data, maybe a couple rows for each cost laid out like in your spreadsheet?

 

[Seti]

I think this is what you want to do, but I am not sure. I am including a picture just to show how I assumed the layout would look. The first row is blank and I think it must remain so. The second is headers and the third row down to row 50,000 has data. Columns E and F show a portion of my results. Row 2 is headers that you would supply, doesn't matter what they are. The formulas in column F are put there by the macro. You can always range value them if you like.

jp33guy.xls
	A	B	C	D	E	F
1
2	Obs	Risk	Cost		Risk	Cost
3	1	0.41	165.82		0.41	1.04
4	2	0.02	479.27		0.02	0.13
5	3	0.54	130.16		0.54	3.94
6	4	0.27	563.17		0.27	2.87
Sheet2

Then I use this macro to populate columns E and F.

Sub Macro2()
Dim lastRow As Long, lastRow2 As Long
    Application.ScreenUpdating = False
    lastRow = Range("E65536").End(xlUp).Row
    If lastRow > 2 Then
        Range("E3:F" & lastRow).ClearContents
    End If
    lastRow = Range("B3").End(xlDown).Row
    Range("B2:B" & lastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E2"), Unique:=True
    lastRow2 = Range("E3").End(xlDown).Row
    Range("F3").Select
    form = "R3C2:R" & lastRow & "C2=RC5,R3C3:R" & lastRow & "C3"
    Selection.FormulaArray = "=MIN(IF(" & form & "))"
    Selection.Copy
    Range("F4:F" & lastRow2).PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Let me know if this does what you need.

 

[j33pguy]

when i run this code, i get a hang up! not sure why
it doesn't give an error, but just times out!

it times out on this line!

Range("B2:B" & lastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E2"), Unique:=True

 

[Seti]

I think you are using an Excel newer than 2K. I suggest that you record a macro that sets an advanced filter, unique records and copy to another location. Then comare to what I provided and see if you need anything different.

Or, are you sure A1:C1 is blank?

 

[j33pguy]

i'm using excel 2003.
i'm not sure what you're talking about recording a macro....
i mean, i know how to create one, but don't know what exactly i should have it do!


Could anyone help me find out how i can make the following code compatible with excel 2003? please!

Sub Macro2() 
Dim lastRow As Long, lastRow2 As Long 
    Application.ScreenUpdating = False 
    lastRow = Range("E65536").End(xlUp).Row 
    If lastRow > 2 Then 
        Range("E3:F" & lastRow).ClearContents 
    End If 
    lastRow = Range("B3").End(xlDown).Row 
    Range("B2:B" & lastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("E2"), Unique:=True 
    lastRow2 = Range("E3").End(xlDown).Row 
    Range("F3").Select 
    form = "R3C2:R" & lastRow & "C2=RC5,R3C3:R" & lastRow & "C3" 
    Selection.FormulaArray = "=MIN(IF(" & form & "))" 
    Selection.Copy 
    Range("F4:F" & lastRow2).PasteSpecial xlPasteFormulas 
    Application.CutCopyMode = False 
    Application.ScreenUpdating = True 
End Sub

 

[Seti]

I was suggesting that some of the Advanced Filter syntax might be different between 2K and 2003. I only have 2K so I can't test it.

I figured if you recorded a macro doing the advanced filter part, something might jump out to say "I need to add this option".

 

[j33pguy]

i see what you're saying.....
i just recorded a macro.....and this is what it looks like (i didn't notice any differences!)

Sub Macro222()

    Range("C4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "D4"), Unique:=True
End Sub

 

[Seti]

Yeah, I don't see any differences either. Can you step through the code to be sure that is the line hanging it up? I know that the paste line takes a long time.