Sorting problem

[Giggzz]

TEST.xls
	A	B	C	D	E	F	G	H
1		EMPLOYEE NAME	TITLE	WEEK	TEMP	REG	OT	DT
2					RATE	HOURS	HOURS	HOURS
3	Zb1	Zb	MANAGER	WEEK1	exempt
4	Zb2	99150	56075	WEEK2	exempt
5	Zb3	Hire Date:	1/12/00	VAC Rate
6	Zb4	Years of Service:	2	SIC/Per
7	Zb5		OFFICE OF YEAR RATE
8	Zb6		CELEBRATE HRS RATE
9	Zb7		HOLIDAY PAY RATE
10	Zb8
11	Zc1	Zc	FOREMAN	WEEK1	$0.00
12	Zc2	100138	056198	WEEK2	$0.00
13	Zc3	Hire Date:	7/13/06	VAC Rate
14	Zc4	Years of Service:	5	SIC/Per
15	Zc5		OFFICE OF YEAR RATE
16	Zc6		CELEBRATE HRS RATE
17	Zc7		HOLIDAY PAY RATE
18	Zc8
19	Za1	Za	FOREMAN	WEEK1	$0.00
20	Za2	123456	056198	WEEK2	$0.00
21	Za3	Hire Date:	8/1/06	VAC Rate
22	Za4	Years of Service:	1	SIC/Per
23			OFFICE OF YEAR RATE
24			CELEBRATE HRS RATE
25			HOLIDAY PAY RATE
Sheet1

Public Sub GroupSort()
'On Error GoTo TheEnd:
Application.ScreenUpdating = False

msg = "Indicate Row to Start Sort On"
StartRow = Application.InputBox(msg, "First Sort Row", 8, Type:=1)
If StartRow = False Then Exit Sub

' ADD A SORT COLUMN
 Columns("A:A").Insert Shift:=xlToRight
 
 ' POPULATE SORT COLUMN
 Call PopulateSortColumn(StartRow)

' SORT BY SORT COLUMN
With Range("A" & StartRow & ":S" & Cells(65536, 2).End(xlUp).Row + 1)
    .Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

' REMOVE TEMP SORT COLUMN
Columns("A:A").Delete Shift:=xlToLeft

TheEnd:
Application.ScreenUpdating = True
ActiveSheet.Protect "national"

End Sub

Private Sub PopulateSortColumn(StartRow)

For rw = StartRow To Cells(65536, 2).End(xlUp).Row + 1

    'DETERMINE IF NEW START OF NEW EMPL GROUP
    Empl = Trim(Cells(rw, 2).Value)
    On Error Resume Next
    Title = Trim(Cells(rw, 3).Value)
    If Len(Empl) > 0 And Len(Title) > 0 And _
    Not IsNumeric(Empl) And Not IsNumeric(Title) And _
    Not (IsDate(Title)) Then
    
        CurrEmpl = Empl
        SortNum = 1
    End If
    
    'ADD EMPL NAME TO EACH OF THEIR ROWS WITH A SORT NUMBER
    Cells(rw, 1).Value = CurrEmpl & SortNum
    
    ' Increment SortNum
    SortNum = SortNum + 1

Next rw
End Sub

Happy holiday to all....

I was playing around with expanding my excel form and added a a few other items to have sorted. I added to be included in the sort were Office of the Year, Celebrate Hrs Rate, and Holiday Pay Rate. The code is excuting but is not identifing(including) the last 3 cells(A23:A25) so when the sorting takes place its all out of position.

Any idea on how to tackle this, been on it all weekend.

Thanks!!

 

[Bruno_x]

With Range("A" & StartRow & ":S" & Cells(65536, 2).End(xlUp).Row + 1) 
    .Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlNo, _ 
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

You use column B to search the last row that is used, right ? Cells(65536, 2).End(xlUp)
But before this you insert a new column to sort the list. So column B is now C. If you use column C instead of column B, I think you problem is solved... (not really tried)