Any help would be appreciated
Code:
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