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 |
Code:
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!!