Necesito depurar una Macro que compara datos

Hice una macro que me compara informacion entre dos celdas, pero creo que se puede depurar espero me ayuden.
Rapidamente comento: tengo una base de 5000 datos y unicamente en 4 necesito identificarlos, para eso la macro, me agrega un renglon y me los identifica agregando la terminacion "B".
Aqui esta la macro
Gracias de antemano
Sub comparar()
'
' comparar Macro
'
' Acceso directo: Ctrl+Mayús+M
'
ActiveSheet.Range("b11").Select
While ActiveCell.Value <> ""
If Mid(ActiveCell, 1, 9) = Mid(ActiveCell.Offset(1, 0), 1, 9) Then
ActiveCell.Offset(1, 0).Select
Else
    If Mid(ActiveCell, 1, 9) = "05-01-401" Then
        ActiveCell.Offset(1, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, 1).Value = "05-01-401B"
    End If
    If Mid(ActiveCell, 1, 9) = "05-07-201" Then
        ActiveCell.Offset(1, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, 1).Value = "05-07-201B"
    End If
End If
ActiveCell.Offset(1, 0).Select
Wend
ActiveSheet.Range("b11").Select
While ActiveCell.Value <> ""
If Mid(ActiveCell, 1, 9) = Mid(ActiveCell.Offset(1, 0), 1, 9) Then
ActiveCell.Offset(1, 0).Select
Else
    If Mid(ActiveCell, 1, 9) = "05-07-201" Then
        ActiveCell.Offset(1, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, 1).Value = "05-07-201B"
    End If
End If
ActiveCell.Offset(1, 0).Select
Wend
ActiveSheet.Range("b11").Select
While ActiveCell.Value <> ""
If Mid(ActiveCell, 1, 9) = Mid(ActiveCell.Offset(1, 0), 1, 9) Then
ActiveCell.Offset(1, 0).Select
Else
    If Mid(ActiveCell, 1, 9) = "05-08-201" Then
        ActiveCell.Offset(1, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, 1).Value = "05-08-201B"
    End If
End If
ActiveCell.Offset(1, 0).Select
Wend
ActiveSheet.Range("b11").Select
While ActiveCell.Value <> ""
If Mid(ActiveCell, 1, 9) = Mid(ActiveCell.Offset(1, 0), 1, 9) Then
ActiveCell.Offset(1, 0).Select
Else
    If Mid(ActiveCell, 1, 9) = "05-08-301" Then
        ActiveCell.Offset(1, 1).EntireRow.Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.Offset(0, 1).Value = "05-08-301B"
    End If
End If
ActiveCell.Offset(1, 0).Select
Wend
End Sub