Sub RunMe() Dim x, y As Integer y = 2 NewDate: x = 0 If Range("B" & y) <> vbNullString Then Range("C" & y).Value = Range("B" & y).Value x = 1 End If Do If Range("A" & y) = Range("A" & y - 1) And _ Range("B" & y) <> vbNullString And _ x < 2 Then Range("C" & y).Value = Range("B" & y).Value x = x + 1 End If y = y + 1 If Range("A" & y) <> Range("A" & y - 1) Then GoTo NewDate Loop Until Range("A" & y) = vbNullString End Sub
Sub RunMe() Dim x, y, HighVal, SecHighVal, Rep As Integer Dim mDate As Date x = 2 y = 2 NextDate: Do mDate = Range("A" & x) y = y + 1 Loop Until mDate <> Range("A" & y) Range(Cells(x, "B"), Cells(y - 1, "B")).Select HighVal = Application.WorksheetFunction.Max(Selection) SecHighVal = Application.WorksheetFunction.Large(Selection, 2) For Each cell In Selection If cell.Value = HighVal And Rep < 2 Then cell.Offset(0, 1).Value = cell.Value Rep = Rep + 1 End If Next cell For Each cell In Selection If cell.Value = SecHighVal And Rep < 2 Then cell.Offset(0, 1).Value = cell.Value Rep = Rep + 1 End If Next cell Rep = 0 If Range("A" & y).Value = vbNullString Then Exit Sub x = y GoTo NextDate End Sub
DON'T MISS
You're a life saver it worked :)
I only had a minor problem cause the dates have time but I just removed the time on the dates and your script works.
Thanks again.