I did fail to include the first 2 lines

Option Explicit

Sub SortOffice()

but beyond that it is the complete code and it works with the exception of
what I noted in the original post (the 1st and 2nd time the UserForm enters
a name it sorts all 5 rows correctly, after that it excludes the first row
when sorting). Now I did not include the UserForm code that places the data
in the cell and calls the SortOffice routine and have now included that
below.

To the more important issue, p45cal's comment. I have to admit he is mostly
right as of late. So I must apologies to you and the many others how have
provided invaluable assistance, not only on this question but many others.
It becomes easy in animosity to take for granted the assistance that one
receives. I do appreciate all the help, but then how would anyone know that
if I do not take the time to say Thanks. So I shall endeavor to do better.
I will begin here.

Thanks for the time and help you have provided it is appreciated.


Private Sub OK_Click()

ThisWorkbook.Activate
Application.ScreenUpdating = False
On Error GoTo Sub1

Selection.Value = ListBox1.List(ListBox1.ListIndex, 0)

Sub1:

SortCells.SortOffice

Range("A3").Select

ActiveWorkbook.Save

Application.ScreenUpdating = True
Unload EmployeeList

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''''''

Option Explicit

Sub SortOffice()

bSELCTIONCHANGE = False

On Error GoTo ErrorHandler

Events.Disable_Events
Application.ScreenUpdating = False

Dim c As Range
Dim rowtop As Integer
Dim row1 As Integer
Dim Row5 As Integer


Set c = ActiveCell

If ActiveCell.Row < 10 Then
rowtop = 4
row1 = 5
Row5 = 9
End If


If Range("E" & rowtop).Value = Range("w1").Value Then

GoTo Continue2

End If

If Range("E" & rowtop).Value "" Then
Range("D" & row1 & ":E" & Row5).Select
Selection.Sort Key1:=Range("D" & row1), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

End If

Continue2:


c.Select

ErrorHandler:

bSELCTIONCHANGE = True

Application.ScreenUpdating = True

Events.Enable_Events


End Sub