Sorted Data Validation List on Another Sheet code very wordy.

Hello!

I have a clunky code which takes the value in cell C5 on SHEETB and uses it for a dropdown validation list from a named range on SHEETA.
If the C5 value is not on the dropdown, it asks you if you want to add it, so the next time you use that worksheet, you won't have to re-type that new value.

So as new values get added, the dropdown list grows and it does a sort so that the list is always in alphabetical order.

I'd appreciate it if someone can look at this code. I used the macro recorder alot, and this result works but it seems to me like some of the steps can be combined. And then I set the range to 10,000 entries so I'm not sure what's going to happen if there's 10,001 (will that one not get sorted?), etc.

Regards,
Leaning

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
On Error GoTo OrderlyExit
If Target.Cells.Count > 1 Then Exit Sub
If Target.Address = "$C$5" Then
If IsEmpty(Target) Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountIf(ThisWorkbook.Names("UnitInfo").RefersToRange, Target) = 0 Then
lReply = MsgBox("Add " & Target & " to list? (Note: Once it's there, you're stuck with it.)", vbYesNo + vbQuestion)
If lReply = vbYes Then
'Sheets("SheetA").Unprotect Password:="unprotect"
With ThisWorkbook.Names("UnitInfo").RefersToRange.Cells(ThisWorkbook.Names("UnitInfo").RefersToRange.Rows.Count, 1)
If Len(.Value) > 0 Then
.Offset(1, 0).Value = Target
Else
.Value = Target
End If
MsgBox (Target & " added to list.")
End With
'Sheets("SheetA").Protect Password:="protect"
End If
End If
Application.EnableEvents = True
End If
ActiveWorkbook.Sheets("SHEETA").Select
    ActiveWorkbook.Sheets("SHEETA").Columns("D:D").Select
    ActiveWorkbook.Worksheets("SHEETA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SHEETA").Sort.SortFields.Add Key:=Range("D1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("SHEETA").Sort
        .SetRange Range("D1:D10000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
  
End With
Sheets("SHEETB").Select
Range("C5").Select
OrderlyExit: Application.EnableEvents = True
End Sub