Sub rty()
Dim x, y(), t( 1 ), i&, j&, s$
x = Range("A1:B" & Cells(Rows.Count,  1 ).End(xlUp).Row).Value
On Error Resume Next
With New Collection
    For i =  1  To UBound(x)
        s = Split(x(i,  1 ), "-")( 2 ): t( 0 ) = x(i,  1 ): t( 1 ) = x(i,  2 )
        If IsEmpty(.Item(s)) Then
            For j =  1  To .Count
                If Val(s) < Val(Split(.Item(j)( 0 ), "-")( 2 )) Then Exit For
            Next
            If j > .Count Then .Add t, s Else .Add t, s, Before:=j
        End If
    Next
    ReDim y( 1  To .Count,  1  To  2 )
    For i =  1  To .Count
        y(i,  1 ) = .Item(i)( 0 ): y(i,  2 ) = .Item(i)( 1 )
    Next
End With
[a1:b1].Resize(i -  1 ).Value = y
End Sub