Need help with script or formula

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