Here is another option for you.
Thanks!

Sub test()
'this macro assumes your data is in column A if it is not then
'change all references to column A to the letter of your column and then
'all references to column B to the letter of column to the right of
'you column that contain data.

'declare variables
Dim c, LRow

    'finds the last row that contains data sets it variable LRow    
    LRow = Range("A65555").End(xlUp).Row

'selects and inserts a column before column A
Columns("A").Select
Selection.Insert Shift:=xlRight

'for each cell in column B (Column A is now column B since you inserted a column)
'up until the last row
For Each c In Range("B1:B" & LRow)

    'if the first four numbers are less than or equal to 999 then    
    If Left(c.Value, 4) <= 999 Then

        'the value in the inserted column A is equal to the first        
        'three numbers in the cell in column B
        c.Offset(0, -1).Value = Left(c.Value, 3)

    'elseif the first four numbers are greater than 999 then
    'the cell in column A is equal to the first 4 numbers in the cell in column B
    ElseIf Left(c.Value, 4) > 999 Then
        c.Offset(0, -1).Value = Left(c.Value, 4)
    End If

'goes to next cell until the last row that contains data
Next
 
'sort the activesheet by the inserted column A and then by B
ActiveSheet.Range("A1:B" & LRow).Sort Key1:=ActiveSheet.Columns("A"), Order1:=xlAscending, Key2:=ActiveSheet.Columns("B"), Order2:=xlAscending, Header:=xlNo

'select and delete column A and shift the column left
Columns("A").Select
Selection.Delete Shift:=xlLeft

End Sub