D
DtTall
Dim MyRow As Integer
Dim Count As Integer
Dim BigCount As Integer
MyRow = 5
Count = 0
BigCount = 0
Do
Do
Range("F" & MyRow & ":F" & MyRow).Select
If ActiveCell.Formula = "" Then
If Count = 0 Then
Range("I" & MyRow & ":I" & MyRow).Cut
Destination:=Range("K" & MyRow & ":K" & MyRow)
Else
Range("K" & MyRow & ":K" & MyRow).Cut
Destination:=Range("I" & MyRow & ":I" & MyRow)
Range("J" & MyRow & ":J" & MyRow).ClearContents
End If
MyRow = MyRow + 1
Else
MyRow = MyRow + 1
End If
Loop Until MyRow = 800
If Count = 0 Then
MyRow = 5
Range("J" & MyRow & ":J" & MyRow).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],RC[-1]:R[740]C[-1])"
Range("J" & MyRow & ":J" & MyRow).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],R5C9:R740C9)"
Range("J" & MyRow & ":J" & MyRow).Select
Selection.AutoFill Destination:=Range("J" & MyRow & ":J" &
740), Type:=xlFillDefault
Range("J" & MyRow & ":J" & 740).Select
Range("I" & MyRow & ":I" & 740).Cut Destination:=Range("L"
& MyRow & ":L" & 740)
Range("L" & MyRow & ":L" & 740).Copy Destination:=Range("I"
& MyRow & ":I" & 740)
Columns("L:L").Select
Selection.EntireColumn.Hidden = True
End If
Count = Count + 1
BigCount = BigCount + 1
MyRow = 5
Loop Until BigCount = 2
Dim Count As Integer
Dim BigCount As Integer
MyRow = 5
Count = 0
BigCount = 0
Do
Do
Range("F" & MyRow & ":F" & MyRow).Select
If ActiveCell.Formula = "" Then
If Count = 0 Then
Range("I" & MyRow & ":I" & MyRow).Cut
Destination:=Range("K" & MyRow & ":K" & MyRow)
Else
Range("K" & MyRow & ":K" & MyRow).Cut
Destination:=Range("I" & MyRow & ":I" & MyRow)
Range("J" & MyRow & ":J" & MyRow).ClearContents
End If
MyRow = MyRow + 1
Else
MyRow = MyRow + 1
End If
Loop Until MyRow = 800
If Count = 0 Then
MyRow = 5
Range("J" & MyRow & ":J" & MyRow).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],RC[-1]:R[740]C[-1])"
Range("J" & MyRow & ":J" & MyRow).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[-1],R5C9:R740C9)"
Range("J" & MyRow & ":J" & MyRow).Select
Selection.AutoFill Destination:=Range("J" & MyRow & ":J" &
740), Type:=xlFillDefault
Range("J" & MyRow & ":J" & 740).Select
Range("I" & MyRow & ":I" & 740).Cut Destination:=Range("L"
& MyRow & ":L" & 740)
Range("L" & MyRow & ":L" & 740).Copy Destination:=Range("I"
& MyRow & ":I" & 740)
Columns("L:L").Select
Selection.EntireColumn.Hidden = True
End If
Count = Count + 1
BigCount = BigCount + 1
MyRow = 5
Loop Until BigCount = 2