Third and final part:

'************************************************* **************************
'** SortByEmployee P R O C E D U R E
'************************************************* **************************
'Sub SortByEmployee()
'Application.ScreenUpdating = False
'Sheets("Payroll_Entry").Select
'Sheets("Payroll_Entry").Unprotect
'Range("PE_Data").Sort Key1:=Range("C8"), Order1:=xlAscending,
Key2:=Range _
("G8"), Order2:=xlAscending, Key3:=Range("D8"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
'Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
'SendKeys ("^{Home}")
'End Sub

'************************************************* **************************
'** SortByPayRate P R O C E D U R E
'************************************************* **************************
Sub SortByPayRate()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Select
Sheets("Payroll_Entry").Unprotect
Range("PE_Data").Sort Key1:=Range("J8"), Order1:=xlAscending,
Key2:=Range _
("C8"), Order2:=xlAscending, Key3:=Range("G8"), Order3:=xlAscending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Sheets("Payroll_Entry").Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
SendKeys ("^{Home}")
End Sub

'************************************************* **************************
'** SUI F U N C T I O N
'************************************************* **************************
Function SUI(Employee, AdjGross)
If IsError(Employee) Then SUI = 0: Exit Function
EmpYtdGross = Range("Employee_List!A5").Offset(Employee, EL_YTD_GROSS - 1)
If (AdjGross + EmpYtdGross) > 8000 Then
If EmpYtdGross > 8000 Then
SUI = 0
Else
SUI = Application.Round((8000 - EmpYtdGross) * 0.0352, 2)
End If
Else
SUI = Application.Round(AdjGross * 0.0352, 2)
End If
End Function

'************************************************* **************************
'** PSLookup F U N C T I O N
'************************************************* **************************
Function PSLookup(LookupText, EmployeeRow, LookupRow)
PSLookup = Application.HLookup(LookupText, Range("PS_TData"), _
EmployeeRow + EmployeeRow + LookupRow, False)
If IsError(PSLookup) Then PSLookup = 0
End Function

'************************************************* **************************
'** UpdateCustomerList P R O C E D U R E
'************************************************* **************************
Sub UpdateCustomerList()
RPointer = CL_DATA_ROW
Application.Calculation = xlManual
Range("S_Function").Formula = "Updating Customer List"
Range("S_Counter").Formula = 0
Sheets("Status").Visible = True
Sheets("Status").Select
Application.ScreenUpdating = False
On Error GoTo ErrorHandler ' Enable error-handling routine.
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
PAWData = DDERequest(Channel,
"file=customer,first,field=key,field=name,field=ty pe,field=custom1,field=inactive")
' PAWData = DDERequest(Channel,
"file=customer,first,field=key,field=name,field=re salenumber,field=contact,field=inactive")
NoFields = UBound(PAWData) - 1
Sheets("Customer_List").Select
Sheets("Customer_List").Unprotect
Sheets("Customer_List").Range(Rows(RPointer), Rows(2000)).Delete
Shift:=xlUp
Sheets("Status").Select
Application.ScreenUpdating = True
While Not IsError(PAWData)
If PAWData(NoFields + 1) = "N" Then


Range("S_Counter").Formula = RPointer - 5
Worksheets("Customer_List").Cells(RPointer, 1).Formula = RPointer - 5
For CPointer = 1 To NoFields
Worksheets("Customer_List").Cells(RPointer, CPointer +
1).Formula = _
PAWData(CPointer)
Next CPointer
RPointer = RPointer + 1
End If
PAWData = DDERequest(Channel,
"file=customer,next,field=key,field=name,field=typ e,field=custom1,field=inactive")
' PAWData = DDERequest(Channel,
"file=customer,next,field=key,field=name,field=res alenumber,field=contact,field=inactive")
Wend
Application.ScreenUpdating = False
Application.DDETerminate (Channel)
RPointer = RPointer - 1
Sheets("Customer_List").Select
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 5)).Interior.ColorIndex =
14
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 5)). _
Borders(xlBottom).Weight = xlHairline
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 5)).BorderAround
Weight:=xlThick
ActiveSheet.Range(Cells(6, 2), Cells(RPointer, 2)).Interior.ColorIndex = 8
Names.Add Name:="CL_Data", RefersToR1C1:=Sheets("Customer_List") _
.Range(Cells(6, 2), Cells(RPointer, 5))
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Status").Visible = False
Application.Calculation = xlAutomatic
SendKeys ("^{Home}")
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Application.Calculation = xlAutomatic
Sheets("Status").Visible = False
Sheets("Customer_List").Select
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
End
End Sub

'************************************************* **************************
'** UpdateDeptSum P R O C E D U R E
'************************************************* **************************
Sub UpdateDeptSum()
Application.ScreenUpdating = False
Sheets("Dept_Sum").Select
ActiveSheet.Unprotect
ActiveSheet.PivotTables("DS_PT").RefreshTable
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
End Sub

'************************************************* **************************
'** UpdatePayrollEntry F U N C T I O N
'************************************************* **************************
Sub UpdatePayrollEntry()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheets("Payroll_Entry").Unprotect
RPointer = Range("Payroll_Entry!A7").End(xlDown).Row
Range("PE_Formula").EntireRow.Hidden = False
Range("Payroll_Entry!B5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 2), Cells(RPointer, 2))
Range("Payroll_Entry!D5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 4), Cells(RPointer, 4))
Range("Payroll_Entry!I5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 9), Cells(RPointer, 9))
Range("Payroll_Entry!J5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 10), Cells(RPointer, 10))
Range("Payroll_Entry!K5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 11), Cells(RPointer, 11))
Range("Payroll_Entry!M5").Copy
ActiveSheet.Paste destination:=Range(Cells(8, 13), Cells(RPointer, 13))
Application.Calculation = xlAutomatic
Range("PE_Formula").EntireRow.Hidden = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
End Sub

'************************************************* **************************
'** UpdateEmployeeList P R O C E D U R E
'************************************************* **************************
Sub UpdateEmployeeList()
RPointer = EL_DATA_ROW
Application.Calculation = xlManual
Range("S_Function").Formula = "Updating Employee List"
Range("S_Counter").Formula = 0
Sheets("Status").Visible = True
Sheets("Status").Select
Application.ScreenUpdating = False
On Error GoTo ErrorHandler ' Enable error-handling routine.
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
PAWData = DDERequest(Channel,
"file=employee,first,field=key,field=name,field=fi lingstatus,field=frequency,field=allowances,field= extrafit,field=stateallowances,field=gross,ytd,fie ld=custom1, field=stateadditional, field=inactive")
NoFields = UBound(PAWData) - 1
Sheets("Employee_List").Select
Sheets("Employee_List").Unprotect
Sheets("Employee_List").Range(Rows(RPointer), Rows(999)).Delete
Shift:=xlUp
Sheets("Status").Select
Application.ScreenUpdating = True
While Not IsError(PAWData)
If PAWData(NoFields + 1) = "N" Then
Range("S_Counter").Formula = RPointer - 5
Worksheets("Employee_List").Cells(RPointer, 1).Formula = RPointer - 5
For CPointer = 1 To NoFields
Worksheets("Employee_List").Cells(RPointer, CPointer +
1).Formula = _
PAWData(CPointer)
Next CPointer
RPointer = RPointer + 1
End If
PAWData = DDERequest(Channel,
"file=employee,next,field=key,field=name,field=fil ingstatus,field=frequency,field=allowances,field=e xtrafit,field=stateallowances,field=gross,ytd,fiel d=custom1,field=stateadditional,field=inactive")
Wend
Application.ScreenUpdating = False
Application.DDETerminate (Channel)
RPointer = RPointer - 1
Sheets("Employee_List").Select
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 11)).Interior.ColorIndex
= 14
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 11)) _
.Borders(xlBottom).Weight = xlHairline
ActiveSheet.Range(Cells(6, 1), Cells(RPointer, 11)).BorderAround
Weight:=xlThick
ActiveSheet.Range(Cells(6, 2), Cells(RPointer, 2)).Interior.ColorIndex = 8
Names.Add Name:="EL_Data", RefersToR1C1:=Sheets("Employee_List") _
.Range(Cells(6, 2), Cells(RPointer, 11))
Names.Add Name:="EL_ID", RefersToR1C1:=Sheets("Employee_List") _
.Range(Cells(6, 2), Cells(RPointer, 2))
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Status").Visible = False
Application.Calculation = xlAutomatic
SendKeys ("^{Home}")
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Application.Calculation = xlAutomatic
Sheets("Status").Visible = False
Sheets("Employee_List").Select
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
End
End Sub

'************************************************* **************************
'** UpdatePayrollCalc P R O C E D U R E
'************************************************* **************************
Sub UpdatePayrollCalc()
Application.ScreenUpdating = False
' If MsgBox("Do you also want to update the Customer & Employee list?",
4) = 6 Then
' UpdateCustomerList
UpdateEmployeeList
' End If
UpdatePayrollSum
RPointer = Range("Payroll_Sum!A:A").Find("Total Sum of Hours").Row + 1
Sheets("Payroll_Calc").Select
ActiveSheet.Unprotect
Range(Rows(PC_DATA_ROW), Rows(999)).Delete Shift:=xlUp
Range("PC_Formula").EntireRow.Hidden = False
Range("PC_Formula").Copy
Range(Rows(PC_DATA_ROW), Rows(RPointer)).Insert Shift:=xlDown
Range("PC_Formula").EntireRow.Hidden = True
Range("Payroll_Calc!C8").Formula = "=COUNTIF(C10:C" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ")"
Range("Payroll_Calc!D8").Formula = "=SUMIF(B10:B" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ",D10:D" & Format(RPointer) & ")"
Range("Payroll_Calc!E8").Formula = "=SUMIF(B10:B" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ",E10:E" & Format(RPointer) & ")"
Range("Payroll_Calc!F8").Formula = "=SUMIF(B10:B" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ",F10:F" & Format(RPointer) & ")"
Range("Payroll_Calc!G8").Formula = "=SUMIF($B10:$B" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ",G10:G" & Format(RPointer) & ")"
Range("Payroll_Calc!AK8").Formula = "=SUMIF(B10:B" & Format(RPointer _
) & "," & Chr(34) & "*" & Chr(34) & ",AK10:AK" & Format(RPointer) &
")"
Range("Payroll_Calc!G8").Copy
ActiveSheet.Paste destination:=Range("Payroll_Calc!H8:AJ8")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
End Sub

'************************************************* **************************
'** UpdatePayrollSum P R O C E D U R E
'************************************************* **************************
Sub UpdatePayrollSum()
Application.ScreenUpdating = False
'SortByEmployee
Sheets("Payroll_Sum").Select
ActiveSheet.Unprotect
ActiveSheet.PivotTables("PS_PT").RefreshTable
On Error Resume Next
ActiveSheet.PivotTables("PS_PT").PivotFields("Emp. ID") _
.PivotItems("(blank)").Visible = False
ActiveSheet.PivotTables("PS_PT").PivotFields("Emp. Name") _
.PivotItems("(blank)").Visible = False
ActiveSheet.PivotTables("PS_PT").PivotFields("Emp. Name") _
.PivotItems("#N/A").Visible = False
On Error GoTo 0
CPointer = Range("Payroll_Sum!6:6").Find("Grand Total").Column
RPointer = Range("Payroll_Sum!A:A").Find("Total Sum of Hours").Row + 1
Names.Add Name:="PS_TData", RefersToR1C1:= _
Sheets("Payroll_Sum").Range(Cells(6, 4), Cells(RPointer, CPointer))
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
End Sub