Macros problem with XP

[Gretchen Hembree]

For SEVERAL years our accounting department has been using macros set up in
Excel to import data into our Peachtree Accounting software. (I did not set
these macros up, nor know how to!) We recently got new computers that have
Windows XP Professional. When we try to run the Macros the following error
comes up: "Remote Data not accessible. Start application 'PEACHW.EXE'?" Even
when you click yes, the following message comes up: "The Peachtree accounting
program must be running in the background before running this function.
Start Peachtree then try again." I have tried having Peachtree open, closed,
just about anything I can think of. I don't want to change the macros
because they are working just fine for our Windows 98 machines. Please help!
Let me know if you need additional information. Even our IT consultant is
currently stumped. ~Gretchen

 

[K Dales]

It would help if you could post the macro code. The most important part is
where it is trying to do the import and it obviously is checking to see if
Peachtree is running. The solution will depend on what method the macro uses
to see if Peachtree is open. The error messages you note must be "hard
coded" in the macro code, so the code that surrounds those messages would be
key to understanding what is happening.

 

[Gretchen Hembree]

It is too long for one posting so I am seperating it into three postings.
Here is the first part:

'**************************************************************************
'** FILE: PAYROLL.XLS
'** PURPOSE: Generate Invoice & Payroll transactions via DDE into Peachtree.
'** AUTHOR: Conrad R. Meitl, KHS
'** CREATED: December 08, 1994
'** REVISED: DATE SE DESCRIPTION
'** 12/09/94 KHS/CM Added Edit button to Payroll_Entry sheet.
'** 12/11/94 KHS/CM Eliminated screen update during execution.
'** 12/13/94 KHS/CM Added Add button to Payroll_Entry sheet.
'** 12/15/94 KHS/CM Added status display window during processing.
'** 01/25/95 KHS/CM Updated tax tables.
'** 07/18/95 LM Changed SUI to 0.
'** 12/28/95 CRM Updated 1996 tax tables.
'** 12/14/96 LM Changed departments - adding 1,2, or 3 for
offices.
'** 12/26/96 CRM/LM Updated 1997 tax tables.
'** 12/23/97 CRM/LM Updated 1998 tax tables.
'** 02/18/98 CRM/LM Always update customer and employee list.
'** 01/04/99 CRM/LM/TW Updated 1999 tax tables.
'** 04/23/99 CRM Widen year fields to 4 places.
'** 12/29/99 LM/TW/CRM Updated 2000 tax tables.
'** 12/28/00 LM/TW Updated 2001 tax tables.
'** 07/02/01 LM Updated 2001 tax tables for FIT only.
'** 12/31/01 LM/TW Updated 2002 tax tables.
'** 12/30/02 TW Updated 2003 tax tables.
'** 06/19/03 VS Removed "SortbyEmp" procedure; removed
"SortbyEmp" in UpdatePayrollSummary Procedure.
'** 09/10/03 TW Updated tax tables
'** NOTES: This program requires a Peachtree password with access to
employee,
'** customer, payroll and invoice screens.
'** Some worksheet items are hidden to improve appearance. These
items
'** can be displayed for maintenance by running the
"SetDevelopmentEnv"
'** macro. They can be rehidden with the "SetProductionEnv" macro.
'** SETUP: Copy the Peachtree Alert, Alarm and Eventlog file to the Peachtree
'** program directory to eliminate problem with Peachtree DDE Open.
'** USAGE:
'** Step 1
'** Make all employee & customer updates within Peachtree. Import the
Peachtree
'** Employee & Customer information into this worksheet by clicking on the
Update
'** button on the Employee_List & Customer_List screen.
'** Step 2
'** Enter the current periods employee time sheet information into the
Payroll
'** worksheet Payroll_Entry screen.
'** "Add" Button - Add an additional line to the Payroll_Entry screen for
'** time sheet data entry. (Ctrl-C)
'** "Input / Edit" Button - Display the time sheet data entry form for
'** time sheet input & editing. (Ctrl-E)
'** "Sort By Emp" Button - Sorts time sheet data by Employee ID.
'** "Sort By Dept" Button - Sorts time sheet data by Department.
'** "Sort By Cust" Button - Sorts time sheet data by Customer ID.
'** "Print" Button - Print entire payroll entry sheet.
'** "Reset" Button - Delete previously entered time sheet data.
'** Step 3
'** Calculate employee payroll deductions by clicking on the Update button
on the
'** Payroll worksheet Payroll_Calc screen. Only enter additional employee
income
'** and deduction after clicking on the Update button. Clicking on the
Update button
'** will reset any previously entered special payroll income or
deductions. Additional
'** income should be entered as a positive number and deductions as a
negative number.
'** Step 4
'** Create Peachtree payroll & invoice transactions by clicking on the
Generate_Invoice
'** and/or Generate_Payroll button on the Payroll worksheet Payroll_Calc
screen.
'** This step will take a while to complete and may be run overnight.
Peachtree
'** accounting files should be backed up immediately prior to generating
payroll
'** or invoice transactions. If a major error is discovered after the
transactions
'** are generated, the Peachtree accounting files should be restored from
the backup.
'** Step 5
'** Print and verify Peachtree payroll & sales reports. Print customer
invoices and
'** payroll checks from within Peachtree.
'** PROCEDURES:
'** AddPayrollEntry - Add an additional line to Payroll_Entry sheet.
'** ConvertDeptToAccount - Return PAW account # for department.
'** DefineNamedRanges - Define worksheet named ranges (Development).
'** DefinePayrollEntryFormulas - Build Payroll_Entry total formulas.
'** EditPayrollEntry - Allow data entry into Payroll_Entry sheet.
'** FIT - Return federal income tax deduction.
'** FICA - Return Social Security tax deduction.
'** FUTA - Return employer FUTA.
'** GenerateAll - Generate payroll & invoice transactions.
'** GenerateInvoice - Generate Peachtree invoice transactions.
'** GeneratePayroll - Generate Peachtree payroll transactions.
'** GetPayroll - Retrieve poked payroll for verification (Development).
'** GetSales - Retrieve poked invoices for verification (Development).
'** PayFrequencyAnnualConvFactor - Returns employee pay frequency conv
factor.
'** PSLookup - Returns lookup value from PS_TData table.
'** PrintSelectedSheet - Print current worksheet.
'** ResetPayrollEntry - Clear contents of Payroll_Entry sheet.
'** SetDevelopmentEnv - Unprotect & restore development settings
(Development).
'** SetProductionEnv - Protect & restore production settings (Development).
'** SIT - Return state income tax deduction.
'** Sub SortByBillRate - Sort PE_Data by Bill Rate.
'** SortByCustomer - Sort PE_Data by Customer ID.
'** SortByDate- Sort PE_Data by Date.
'** SortByDepartment - Sort PE_Data by Department.
'** SortByEmployee - Sort PE_Data by Employee ID.
'** Sub SortByPayRate - Sort PE_Data by Pay Rate.
'** SUI - Return employer SUI.
'** UpdateCustomerList - Update Customer_List from Peachtree files.
'** UpdateDeptSum - Recalc Dept_Sum pivot table.
'** UpdatePayrollEntry - Update Payroll Entry table department and rate
formulas.
'** UpdateEmplyeeList - Update Employee_List from Peachtree files.
'** UpdatePayrollCalc - Update & recalc Payroll_Calc sheet.
'** UpdatePayrollSum - Recalc Payroll_Sum pivot table.
'***************************************************************************

'***************************************************************************
'** D E C L A R E M O D U L E - L E V E L C O N S T A N T S
'***************************************************************************
'Const COMPANY = "MARCHINC" ' Company Short Name"
Const COMPANY = "AGENCY" ' Company Short Name"
Const PROGRAM = "C:\PEACHW\PEACHW.EXE" ' Program Exec Name
Const CL_DATA_ROW = 6 ' CL First Customer Data
Row
Const EL_DATA_ROW = 6 ' EL First Employee Data
Row
Const EL_STATUS = 4 ' EL "Status" Column Number
Const EL_PAY_FREQ = 5 ' EL "Frequency" Column
Number
Const EL_FED_ALLOW = 6 ' EL "Fed.Allow" Column
Number
Const EL_EXTRA_FIT = 7 ' EL "Extra.FIT" Column
Number
Const EL_EXTRA_SIT = 11 ' EL "Extra.SIT" Column
Number
Const EL_STATE_ALLOW = 8 ' EL "KS.Allow" Column
Number
Const EL_YTD_GROSS = 9 ' EL "YTD.Gross" Column
Number
Const PC_DATA_ROW = 10 ' PC First Employee Data
Row
Const PC_DIST_COLUMN = 7 ' PC First Distribution
Comumn
Const PE_DATA_ROW = 8 ' PE First Employee Data
Row

'***************************************************************************
'** D E C L A R E M O D U L E - L E V E L V A R I A B L E S
'***************************************************************************
Dim CPointer As Integer ' Current Worksheet Column
Dim RPointer As Integer ' Current Worksheet Row
Dim Channel As Integer ' DDE Conversation Ref
Dim PAWData As Variant ' Requested PAW Hdr Data
Dim PAWDist As Variant ' Requested PAW Dist Data

'***************************************************************************
'** AddPayrollEntry F U N C T I O N
'***************************************************************************
Sub AddPayrollEntry()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Unprotect
RPointer = Range("Payroll_Entry!A7").End(xlDown).Row
Range("PE_Formula").EntireRow.Hidden = False
Range("PE_Formula").Copy
Sheets("Payroll_Entry").Rows(RPointer + 1).Insert Shift:=xlDown
Range("PE_Formula").EntireRow.Hidden = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

'***************************************************************************
'** ConvertDeptToAccount F U N C T I O N
'***************************************************************************
Function ConvertDeptToAccount(Dept)
If (VarType(Dept) = vbString) Then
Dept = Val(Right(Dept, 3))
End If
Select Case Dept
Case 100
ConvertDeptToAccount = 511100
Case 119
ConvertDeptToAccount = 525120
Case 120
ConvertDeptToAccount = 511120
Case 125
ConvertDeptToAccount = 525126
Case 126
ConvertDeptToAccount = 511126
Case 128
ConvertDeptToAccount = 525129
Case 129
ConvertDeptToAccount = 511129
Case 131
ConvertDeptToAccount = 511131
Case 133
ConvertDeptToAccount = 511133
Case 135
ConvertDeptToAccount = 511135
Case 140
ConvertDeptToAccount = 511140
Case 141
ConvertDeptToAccount = 511141
Case 142
ConvertDeptToAccount = 511142
Case 145
ConvertDeptToAccount = 511145
Case 150
ConvertDeptToAccount = 511150
Case 151
ConvertDeptToAccount = 511151
Case 152
ConvertDeptToAccount = 511152
Case 155
ConvertDeptToAccount = 511155
Case 159
ConvertDeptToAccount = 511159
Case 160
ConvertDeptToAccount = 511160
Case 161
ConvertDeptToAccount = 511161
Case 162
ConvertDeptToAccount = 511162
Case 163
ConvertDeptToAccount = 511163
Case 164
ConvertDeptToAccount = 511164
Case 165
ConvertDeptToAccount = 511165
Case 166
ConvertDeptToAccount = 511166
Case 167
ConvertDeptToAccount = 511167
Case 170
ConvertDeptToAccount = 511170
Case 172
ConvertDeptToAccount = 511172
Case 173
ConvertDeptToAccount = 511173
Case 174
ConvertDeptToAccount = 511174
Case 175
ConvertDeptToAccount = 511175
Case 176
ConvertDeptToAccount = 511176
Case 180
ConvertDeptToAccount = 511180
Case 182
ConvertDeptToAccount = 511182
Case 195
ConvertDeptToAccount = 511195
Case 196
ConvertDeptToAccount = 511196
Case 200
ConvertDeptToAccount = 511200
Case 219
ConvertDeptToAccount = 525220
Case 220
ConvertDeptToAccount = 511220
Case 225
ConvertDeptToAccount = 525226
Case 226
ConvertDeptToAccount = 511226
Case 228
ConvertDeptToAccount = 525229
Case 229
ConvertDeptToAccount = 511229
Case 231
ConvertDeptToAccount = 511231
Case 233
ConvertDeptToAccount = 511233
Case 235
ConvertDeptToAccount = 511235
Case 240
ConvertDeptToAccount = 511240
Case 245
ConvertDeptToAccount = 511245
Case 250
ConvertDeptToAccount = 511250
Case 251
ConvertDeptToAccount = 511251
Case 252
ConvertDeptToAccount = 511252
Case 260
ConvertDeptToAccount = 511260
Case 261
ConvertDeptToAccount = 511261
Case 262
ConvertDeptToAccount = 511262
Case 263
ConvertDeptToAccount = 511263
Case 264
ConvertDeptToAccount = 511264
Case 265
ConvertDeptToAccount = 511265
Case 266
ConvertDeptToAccount = 511266
Case 267
ConvertDeptToAccount = 511267
Case 270
ConvertDeptToAccount = 511270
Case 272
ConvertDeptToAccount = 511272
Case 274
ConvertDeptToAccount = 511274
Case 275
ConvertDeptToAccount = 511275
Case 276
ConvertDeptToAccount = 511276
Case 280
ConvertDeptToAccount = 511280
Case 282
ConvertDeptToAccount = 511282
Case 295
ConvertDeptToAccount = 511295
Case 296
ConvertDeptToAccount = 511296
Case 300
ConvertDeptToAccount = 511300
Case 319
ConvertDeptToAccount = 525320
Case 320
ConvertDeptToAccount = 511320
Case 325
ConvertDeptToAccount = 525326
Case 326
ConvertDeptToAccount = 511326
Case 328
ConvertDeptToAccount = 525329
Case 329
ConvertDeptToAccount = 511329
Case 331
ConvertDeptToAccount = 511331
Case 333
ConvertDeptToAccount = 511333
Case 335
ConvertDeptToAccount = 511335
Case 338
ConvertDeptToAccount = 511338
Case 339
ConvertDeptToAccount = 511339
Case 340
ConvertDeptToAccount = 511340
Case 341
ConvertDeptToAccount = 511341
Case 345
ConvertDeptToAccount = 511345
Case 350
ConvertDeptToAccount = 511350
Case 351
ConvertDeptToAccount = 511351
Case 352
ConvertDeptToAccount = 511352
Case 360
ConvertDeptToAccount = 511360
Case 361
ConvertDeptToAccount = 511361
Case 362
ConvertDeptToAccount = 511362
Case 363
ConvertDeptToAccount = 511363
Case 364
ConvertDeptToAccount = 511364
Case 365
ConvertDeptToAccount = 511365
Case 366
ConvertDeptToAccount = 511366
Case 367
ConvertDeptToAccount = 511367
Case 370
ConvertDeptToAccount = 511370
Case 372
ConvertDeptToAccount = 511372
Case 374
ConvertDeptToAccount = 511374
Case 375
ConvertDeptToAccount = 511375
Case 376
ConvertDeptToAccount = 511376
Case 395
ConvertDeptToAccount = 511395
Case 396
ConvertDeptToAccount = 511396
Case 419
ConvertDeptToAccount = 525420
Case 420
ConvertDeptToAccount = 511420
Case 425
ConvertDeptToAccount = 525426
Case 426
ConvertDeptToAccount = 511426
Case 428
ConvertDeptToAccount = 525429
Case 429
ConvertDeptToAccount = 511429
Case 431
ConvertDeptToAccount = 511431
Case 433
ConvertDeptToAccount = 511433
Case 435
ConvertDeptToAccount = 511435
Case 436
ConvertDeptToAccount = 511436
Case 439
ConvertDeptToAccount = 511439
Case 440
ConvertDeptToAccount = 511440
Case 441
ConvertDeptToAccount = 511441
Case 445
ConvertDeptToAccount = 511445
Case 450
ConvertDeptToAccount = 511450
Case 451
ConvertDeptToAccount = 511451
Case 452
ConvertDeptToAccount = 511452
Case 460
ConvertDeptToAccount = 511460
Case 461
ConvertDeptToAccount = 511461
Case 462
ConvertDeptToAccount = 511462
Case 463
ConvertDeptToAccount = 511463
Case 464
ConvertDeptToAccount = 511464
Case 465
ConvertDeptToAccount = 511465
Case 466
ConvertDeptToAccount = 511466
Case 467
ConvertDeptToAccount = 511467
Case 470
ConvertDeptToAccount = 511470
Case 472
ConvertDeptToAccount = 511472
Case 474
ConvertDeptToAccount = 511474
Case 475
ConvertDeptToAccount = 511475
Case 476
ConvertDeptToAccount = 511476
Case 480
ConvertDeptToAccount = 511480
Case 562
ConvertDeptToAccount = 511562
Case 563
ConvertDeptToAccount = 511563
Case 566
ConvertDeptToAccount = 511566
Case 572
ConvertDeptToAccount = 511572
Case 576
ConvertDeptToAccount = 511576
Case 580
ConvertDeptToAccount = 511580
Case 633
ConvertDeptToAccount = 511633
Case 640
ConvertDeptToAccount = 511640
Case 662
ConvertDeptToAccount = 511662
Case 663
ConvertDeptToAccount = 511663
Case 672
ConvertDeptToAccount = 511672
Case 676
ConvertDeptToAccount = 511676
Case Else
ConvertDeptToAccount = 51200
End Select
End Function

'***************************************************************************
'** DefineNamedRanges F U N C T I O N
'***************************************************************************
Sub DefineNamedRanges()
SetDevelopmentEnv
' CL_Data - Customer_List ID & Name range wo/column headings.
' Defined in UpdateCustomerList
' EL_Data - Employee_List ID & Name range wo/column headings.
' Defined in UpdateEmployeeList
' EL_ID - Employee_List ID range wo/column heading.
' Defined in UpdateEmployeeList
' I_Account - Invoice Account # distribution work area.
Names.Add Name:="I_Account", RefersToR1C1:="=Work!R5C2"
' I_Amount - Invoice Amount distribution work area.
Names.Add Name:="I_Amount", RefersToR1C1:="=Work!R5C3"
' I_Description - Invoice Description distribution work area.
Names.Add Name:="I_Description", RefersToR1C1:="=Work!R5C6"
' I_Distribution - Work area for poking invoice distribution.
Names.Add Name:="I_Distribution", RefersToR1C1:="=Work!R5C2:R5C9"
' I_Item - Invoice Item distribution work area.
Names.Add Name:="I_Item", RefersToR1C1:="=Work!R5C4"
' I_Quanity - Invoice Quanity distribution work area.
Names.Add Name:="I_Quanity", RefersToR1C1:="=Work!R5C5"
' P_Account - Payroll Account # distribution work area.
Names.Add Name:="P_Account", RefersToR1C1:="=Work!R3C2"
' P_Amount - Payroll Amount distribution work area.
Names.Add Name:="P_Amount", RefersToR1C1:="=Work!R3C3"
' P_CheckDate - Payroll CheckDate header work area.
Names.Add Name:="P_CheckDate", RefersToR1C1:="=Work!R7C2"
' P_Distribution - Work area for poking payroll distribution.
Names.Add Name:="P_Distribution", RefersToR1C1:="=Work!R3C2:R3C5"
' P_Employee - Payroll Employee header work area.
Names.Add Name:="P_Employee", RefersToR1C1:="=Work!R7C3"
' P_Field - Payroll Field distribution work area.
Names.Add Name:="P_Field", RefersToR1C1:="=Work!R3C4"
' P_Header - Payroll header work area.
Names.Add Name:="P_Header", RefersToR1C1:="=Work!R7C2:R7C6"
' P_RegHours - Payroll RegHours header work area.
Names.Add Name:="P_RegHours", RefersToR1C1:="=Work!R7C4"
' P_SpecHours - Payroll SpecHours header work area.
Names.Add Name:="P_SpecHours", RefersToR1C1:="=Work!R7C6"
' P_OTHours - Payroll OTHours header work area.
Names.Add Name:="P_OTHours", RefersToR1C1:="=Work!R7C5"
' PC_Formula - Payroll_Calc table summary formula row.
Names.Add Name:="PC_Formula", RefersToR1C1:="=Payroll_Calc!R4:R5"
' PE_CheckDate - Payroll_Entry "Check Date".
Names.Add Name:="PE_CheckDate", RefersToR1C1:="=Payroll_Entry!R1C11"
' PE_Data - Payroll_Entry Timesheet entry range wo/column headings.
' Defined in DefinePayrollEntryFormulas
' PE_Formula - Payroll_Entry data entry formula row.
Names.Add Name:="PE_Formula", RefersToR1C1:="=Payroll_Entry!R5:R5"
' PE_Header - Payroll_Entry header rows.
Names.Add Name:="PE_Header", RefersToR1C1:="=Payroll_Entry!R1:R6"
' PE_InvoiceDate - Payroll_Entry "Invoice Date".
Names.Add Name:="PE_InvoiceDate", RefersToR1C1:="=Payroll_Entry!R3C11"
' PE_PeriodEndDate - Payroll_Entry "Period End Date".
Names.Add Name:="PE_PeriodEndDate", RefersToR1C1:="=Payroll_Entry!R2C11"
' PE_Table - Payroll_Entry Timesheet entry range w/column headings.
' Defined in DefinePayrollEntryFormulas
' PC_TData - Pivot table w/total column header wo/row desc.
' Defined in UpdatePayrollSum
' PWord - DDE Link PWord.
Names.Add Name:="PWord", RefersToR1C1:="=Work!R1C2"
' S_Counter - Status of current procedure.
Names.Add Name:="S_Counter", RefersToR1C1:="=Status!R5C3"
' S_Function - Description of current procedure.
Names.Add Name:="S_Function", RefersToR1C1:="=Status!R3C3"
' DS_PT - Dept_Sum pivot table name.
' PS_PT - Payroll_Sum pivot table name.
DefinePayrollEntryFormulas
End Sub

'***************************************************************************
'** DefinePayrollEntryFormulas F U N C T I O N
'***************************************************************************
Sub DefinePayrollEntryFormulas()
Sheets("Payroll_Entry").Unprotect
RPointer = Range("Payroll_Entry!A7").End(xlDown).Row + 1
Range("Payroll_Entry!C6").Formula = "=COUNTA(C8:C" & Format(RPointer) &
")"
Range("Payroll_Entry!D6").Formula = "=COUNT(D8" & Format(RPointer) & ")"
Range("Payroll_Entry!E6").Formula = "=COUNT(E8:E" & Format(RPointer) & ")"
Range("Payroll_Entry!F6").Formula = "=COUNT(F8:F" & Format(RPointer) & ")"
Range("Payroll_Entry!G6").Formula = "=COUNT(G8:G" & Format(RPointer) & ")"
Range("Payroll_Entry!H6").Formula = "=SUM(H8:H" & Format(RPointer) & ")"
Range("Payroll_Entry!I6").Formula = "=COUNTA(I8:I" & Format(RPointer) &
")"
Range("Payroll_Entry!J6").Formula = "=COUNT(J8:J" & Format(RPointer) & ")"
Range("Payroll_Entry!K6").Formula = "=COUNT(K8:K" & Format(RPointer) & ")"
Range("Payroll_Entry!L6").Formula = "=COUNTA(L8:L" & Format(RPointer) &
")"
Range("Payroll_Entry!M6").Formula = "=COUNTA(M8:M" & Format(RPointer) &
")"
' Range("Payroll_Entry!N6").Formula = "=SUMIF(N8:N" & Format(RPointer) &
',">0")'
' Range("Payroll_Entry!O6").Formula = "=SUM(O8:O" & Format(RPointer) & ")"
Names.Add Name:="PE_Data", RefersToR1C1:= _
Sheets("Payroll_Entry").Range(Cells(8, 3), Cells(RPointer, 12))
Names.Add Name:="PE_Table", RefersToR1C1:= _
Sheets("Payroll_Entry").Range(Cells(7, 2), Cells(RPointer, 16))
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

'***************************************************************************
'** EditPayrollEntry F U N C T I O N
'***************************************************************************
Sub EditPayrollEntry()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Unprotect
' Remove worksheet headers
Range("PE_Header").Select
Range("PE_Header").Cut
ActiveSheet.Paste destination:=Sheets("Work").Range("A10")
Sheets("Payroll_Entry").Select
Selection.Delete Shift:=xlUp
' Display input form
ActiveSheet.ShowDataForm
' Replace worksheet headers
Range("PE_Header").Cut
Sheets("Payroll_Entry").Rows("1:1").Insert Shift:=xlUp
DefinePayrollEntryFormulas
Sheets("Work").Visible = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("{End}{Home}{Home}{End}{UP}")
End Sub

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

'***************************************************************************
'** FIT F U N C T I O N
'***************************************************************************
Function FIT(Employee, AdjGross)
If IsError(Employee) Then FIT = 0: Exit Function
ConvFactor = PayFrequencyAnnualConvFactor(Employee)
AnnualGross = (AdjGross * ConvFactor) - _
(Range("Employee_List!A5").Offset(Employee, EL_FED_ALLOW - 1) * 3200)
If Range("Employee_List!A5").Offset(Employee, EL_STATUS - 1) = "Single"
Then
If AnnualGross <= 2650 Then
Table = 0
ElseIf AnnualGross <= 9800 Then
Table = (AnnualGross - 2650) * 0.1
ElseIf AnnualGross <= 31500 Then
Table = 715 + ((AnnualGross - 9800) * 0.15)
ElseIf AnnualGross <= 69750 Then
Table = 3970 + ((AnnualGross - 31500) * 0.25)
ElseIf AnnualGross <= 151950 Then
Table = 13532.5 + ((AnnualGross - 69750) * 0.28)
ElseIf AnnualGross <= 328250 Then
Table = 36548.5 + ((AnnualGross - 151950) * 0.33)
Else
Table = 94727.5 + ((AnnualGross - 328250) * 0.35)
End If
Else
If AnnualGross <= 8000 Then
Table = 0
ElseIf AnnualGross <= 22600 Then
Table = (AnnualGross - 8000) * 0.1
ElseIf AnnualGross <= 66200 Then
Table = 1460 + ((AnnualGross - 22600) * 0.15)
ElseIf AnnualGross <= 120750 Then
Table = 8000 + ((AnnualGross - 66200) * 0.25)
ElseIf AnnualGross <= 189600 Then
Table = 21637.5 + ((AnnualGross - 120750) * 0.28)
ElseIf AnnualGross <= 333250 Then
Table = 40915.5 + ((AnnualGross - 189600) * 0.33)
Else
Table = 88320 + ((AnnualGross - 333250) * 0.35)
End If
End If
FIT = -Application.Round((Table / ConvFactor) + _
Range("Employee_List!A5").Offset(Employee, EL_EXTRA_FIT - 1), 2)
End Function

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

'***************************************************************************
'** GenerateAll F U N C T I O N
'***************************************************************************
Sub GenerateAll()
GeneratePayroll
GenerateInvoice
End Sub

 

[Gretchen Hembree]

Here is the second part.
'***************************************************************************
'** GenerateInvoice F U N C T I O N
'***************************************************************************
Sub GenerateInvoice()
Range("S_Function").Formula = "Generating Invoice Transactions"
Range("S_Counter").Formula = 0
Sheets("Status").Visible = True
Sheets("Status").Select
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Select
'SortByCustomer
On Error GoTo ErrorHandler ' Enable error-handling routine.
' Channel = Application.DDEInitiate("PeachW", COMPANY)
' DDEPoke Channel, "Password", Range("PWord")
Sheets("Status").Select
RPointer = PE_DATA_ROW
Application.Calculation = xlManual
Application.ScreenUpdating = True
Do Until IsEmpty(Sheets("Payroll_Entry").Cells(RPointer, 13)) Or _
IsError(Sheets("Payroll_Entry").Cells(RPointer, 13))
If Sheets("Payroll_Entry").Cells(RPointer, 11) > 0 Then
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
' Poke Invoice Header
DDEPoke Channel, "file=salesjournal,clear,field=customer", _
Sheets("Payroll_Entry").Cells(RPointer, 12)
DDEPoke Channel, "file=salesjournal,field=date",
Range("PE_InvoiceDate")
Do ' Poke Each Disbursment
Range("S_Counter").Formula = RPointer - 7
Range("I_Account").Formula = ConvertDeptToAccount _
(Worksheets("Payroll_Entry").Cells(RPointer, 4).Value)
Range("I_Amount").Formula = _
Worksheets("Payroll_Entry").Cells(RPointer, 15).Value * -1
Range("I_Quanity").Formula = _
Worksheets("Payroll_Entry").Cells(RPointer, 8).Value
Range("I_Description").Formula =
Format(Worksheets("Payroll_Entry"). _
Cells(RPointer, 7).Value, "00000") + " " +
Format(Worksheets _
("Payroll_Entry").Cells(RPointer, 6).Value, "mm/dd/yyyy") + _
" " + CStr(Worksheets("Payroll_Entry").Cells(RPointer,
2).Value)
If Worksheets("Payroll_Entry").Cells(RPointer, 12) = _
Worksheets("Payroll_Entry").Cells(RPointer + 1, 12) _
Then DDEPoke Channel,
"file=salesjournal,field=nextdistribution", _
Range("I_Distribution") _
Else DDEPoke Channel,
"file=salesjournal,field=nextdistribution,save", _
Range("I_Distribution")
RPointer = RPointer + 1
Loop While Worksheets("Payroll_Entry").Cells(RPointer, 12) = _
Worksheets("Payroll_Entry").Cells(RPointer - 1, 12)
Application.DDETerminate (Channel)
Else
RPointer = RPointer + 1
End If
Loop
Application.Calculation = xlAutomatic
Application.ScreenUpdating = False
' Application.DDETerminate (Channel)
Sheets("Payroll_Calc").Select
Sheets("Status").Visible = False
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Sheets("Status").Visible = False
Sheets("Payroll_Calc").Select
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
End
End Sub

'***************************************************************************
'** GeneratePayroll F U N C T I O N
'***************************************************************************
Sub GeneratePayroll()
Range("S_Function").Formula = "Generating Payroll Transactions"
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")
RPointer = PC_DATA_ROW
Range("P_CheckDate").Formula = Range("PE_CheckDate")
Sheets("Status").Select
Application.ScreenUpdating = True
Do Until IsEmpty(Sheets("Payroll_Calc").Cells(RPointer, 2)) Or _
IsError(Sheets("Payroll_Calc").Cells(RPointer, 2))
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
CPointer = PC_DIST_COLUMN
Range("S_Counter").Formula = (RPointer - 8) / 2
' Poke Payroll Header
Range("P_Employee").Formula = _
Worksheets("Payroll_Calc").Cells(RPointer, 3)
Range("P_RegHours").Formula = _
Worksheets("Payroll_Calc").Cells(RPointer, 4)
Range("P_OTHours").Formula = _
Worksheets("Payroll_Calc").Cells(RPointer, 5)
Range("P_SpecHours").Formula = _
Worksheets("Payroll_Calc").Cells(RPointer, 6)
DDEPoke Channel,
"file=payrolljournal,clear,field=date,field=employee,field=regularhours,field=overtimehours,field=specialhours", Range("P_Header")
' Poke Each Disbursment
Do Until IsEmpty(Worksheets("Payroll_Calc").Cells(7, CPointer))
Range("S_Counter").Formula = Format(((RPointer - 8) / 2) + _
((CPointer - 6) / 100), "0.00")
' Poke First Disbursment
If Worksheets("Payroll_Calc").Cells(RPointer + 1, CPointer) > 0 _
Then Range("P_Account").Formula = Worksheets("Payroll_Calc") _
.Cells(RPointer + 1, CPointer).Value _
Else Range("P_Account").Formula = Worksheets("Payroll_Calc") _
.Cells(7, CPointer).Value
Range("P_Amount").Formula = Worksheets("Payroll_Calc") _
.Cells(RPointer, CPointer).Value
Range("P_Field").Formula = Worksheets("Payroll_Calc") _
.Cells(6, CPointer).Value
CPointer = CPointer + 1
If IsEmpty(Worksheets("Payroll_Calc").Cells(7, CPointer)) _
Then DDEPoke Channel,
"file=payrolljournal,field=nextdistribution,save", _
Range("P_Distribution") _
Else DDEPoke Channel,
"file=payrolljournal,field=nextdistribution", _
Range("P_Distribution")
Loop
Application.DDETerminate (Channel)
RPointer = RPointer + 2
Loop
Application.ScreenUpdating = False
' Application.DDETerminate (Channel)
Sheets("Payroll_Calc").Select
Sheets("Status").Visible = False
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Sheets("Status").Visible = False
Sheets("Payroll_Calc").Select
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
End
End Sub

'***************************************************************************
'** GetPayroll F U N C T I O N
'***************************************************************************
Sub GetPayroll() ' Used only for test purposes
Application.Calculation = xlManual
RPointer = 2
Sheets("Test").Select
Range("A1.AA9999").ClearContents
On Error GoTo ErrorHandler ' Enable error-handling routine.
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
PAWData = DDERequest(Channel,
"file=payrolljournal,first,field=employee,field=invoice,field=weeks,field=date,field=description,field=account,field=amount,field=regularhours,field=overtimehours,field=specialhours")
While Not IsError(PAWData)
For CPointer = LBound(PAWData) To UBound(PAWData)
Worksheets("Test").Cells(RPointer, CPointer).Formula =
PAWData(CPointer)
Next CPointer
RPointer = RPointer + 1
PAWDist = DDERequest(Channel,
"file=payrolljournal,field=firstdistribution")
While Not IsError(PAWDist)
For CPointer = LBound(PAWDist) To UBound(PAWDist)
Worksheets("Test").Cells(RPointer, CPointer + 1).Formula = _
PAWDist(CPointer)
Next CPointer
PAWDist = DDERequest(Channel, _
"file=payrolljournal,field=nextdistribution")
RPointer = RPointer + 1
Wend
PAWData = DDERequest(Channel,
"file=payrolljournal,next,field=employee,field=invoice,field=weeks,field=date,field=description,field=account,field=amount,field=regularhours,field=overtimehours,field=specialhours")
Wend
Application.DDETerminate (Channel)
Application.Calculation = xlAutomatic
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Application.Calculation = xlAutomatic
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
Exit Sub
End Sub

'***************************************************************************
'** GetSales F U N C T I O N
'***************************************************************************
Sub GetSales() ' Used only for test purposes
Application.Calculation = xlManual
RPointer = 2
Sheets("Test").Select
Range("A1.AA9999").ClearContents
On Error GoTo ErrorHandler ' Enable error-handling routine.
Channel = Application.DDEInitiate("PeachW", COMPANY)
DDEPoke Channel, "Password", Range("PWord")
PAWData = DDERequest(Channel,
"file=salesjournal,first,field=invoice,field=date,field=description,field=account,field=amount")
While Not IsError(PAWData)
For CPointer = LBound(PAWData) To UBound(PAWData)
Worksheets("Test").Cells(RPointer, CPointer).Formula =
PAWData(CPointer)
Next CPointer
RPointer = RPointer + 1
PAWDist = DDERequest(Channel,
"file=salesjournal,field=firstdistribution")
While Not IsError(PAWDist)
For CPointer = LBound(PAWDist) To UBound(PAWDist)
Worksheets("Test").Cells(RPointer, CPointer + 1).Formula = _
PAWDist(CPointer)
Next CPointer
PAWDist = DDERequest(Channel, _
"file=salesjournal,field=nextdistribution")
RPointer = RPointer + 1
Wend
PAWData = DDERequest(Channel,
"file=salesjournal,next,field=invoice,field=date,field=description,field=account,field=amount")
Wend
Application.DDETerminate (Channel)
Application.Calculation = xlAutomatic
Exit Sub ' Exit Sub before error handler.
ErrorHandler: ' Error-handling routine.
Application.Calculation = xlAutomatic
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")
Exit Sub
End Sub

'***************************************************************************
'** PayFrequencyAnnualConvFactor F U N C T I O N
'***************************************************************************
Function PayFrequencyAnnualConvFactor(Employee)
PayFrequency = Range("Employee_List!A5").Offset(Employee, EL_PAY_FREQ - 1)
Select Case PayFrequency
Case "Weekly"
PayFrequencyAnnualConvFactor = 52
Case "Bi-Weekly"
PayFrequencyAnnualConvFactor = 26
Case "Semi-Monthly"
PayFrequencyAnnualConvFactor = 24
Case "Monthly"
PayFrequencyAnnualConvFactor = 12
Case Else
PayFrequencyAnnualConvFactor = 1
End Select
End Function

'***************************************************************************
'** PrintSheet P R O C E D U R E
'***************************************************************************
Sub PrintSelectedSheet()
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

'***************************************************************************
'** ResetPayrollEntry P R O C E D U R E
'***************************************************************************
Sub ResetPayrollEntry()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Unprotect
Sheets("Payroll_Entry").Range(Rows(PE_DATA_ROW), Rows(999)).Delete
Shift:=xlUp
Range("PE_Formula").EntireRow.Hidden = False
Sheets("Payroll_Entry").Range("PE_Formula").Copy ' Formula row
ActiveSheet.Paste destination:=Sheets("Payroll_Entry").Rows(PE_DATA_ROW)
Range("PE_Formula").EntireRow.Hidden = True
DefinePayrollEntryFormulas
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
End Sub

'***************************************************************************
'** SetDevelopmentEnv F U N C T I O N
'***************************************************************************
Sub SetDevelopmentEnv()
Application.ScreenUpdating = False
' Workbook settings
ActiveWindow.WindowState = xlNormal
Application.DisplayFormulaBar = True
Toolbars(1).Visible = True
' Payroll_Entry screen settings
Sheets("Payroll_Entry").Select
ActiveSheet.Unprotect
Rows("5:5").EntireRow.Hidden = False
Columns("P").EntireColumn.Hidden = False
ActiveWindow.DisplayHeadings = True
' Payroll_Calc screen settings
Sheets("Payroll_Calc").Select
ActiveSheet.Unprotect
Rows("4:6").EntireRow.Hidden = False
Columns("J:Z").EntireColumn.Hidden = False
Columns("AL:AO").EntireColumn.Hidden = False
ActiveWindow.DisplayHeadings = True
' Payroll_Sum screen settings
Sheets("Payroll_Sum").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Dept_Sum screen settings
Sheets("Dept_Sum").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Customer_List screen settings
Sheets("Customer_List").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Employee_List screen settings
Sheets("Employee_List").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Status screen settings
Sheets("Status").Visible = True
Sheets("Status").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Work screen settings
Sheets("Work").Visible = True
Sheets("Work").Select
ActiveSheet.Unprotect
ActiveWindow.DisplayHeadings = True
' Logic screen settings
Sheets("Logic").Visible = True
Sheets("Logic").Select
ActiveSheet.Unprotect
Sheets("Payroll_Entry").Select
End Sub

'***************************************************************************
'** SetProductionEnv F U N C T I O N
'***************************************************************************
Sub SetProductionEnv()
Application.ScreenUpdating = False
DefineNamedRanges
' Workbook settings
ActiveWindow.WindowState = xlMaximized
Application.DisplayFormulaBar = False
Toolbars(1).Visible = False
Toolbars(2).Visible = False
Toolbars(5).Visible = False
' Payroll_Entry screen settings
Sheets("Payroll_Entry").Select
ActiveSheet.Unprotect
Rows("5:5").EntireRow.Hidden = True
Columns("P").EntireColumn.Hidden = True
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Payroll_Calc screen settings
Sheets("Payroll_Calc").Select
ActiveSheet.Unprotect
Rows("4:6").EntireRow.Hidden = True
Columns("J:Z").EntireColumn.Hidden = True
Columns("AL:AO").EntireColumn.Hidden = True
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Payroll_Sum screen settings
Sheets("Payroll_Sum").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Dept_Sum screen settings
Sheets("Dept_Sum").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Customer_List screen settings
Sheets("Customer_List").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Employee_List screen settings
Sheets("Employee_List").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
SendKeys ("^{Home}")
' Status screen settings
Sheets("Status").Visible = True
Sheets("Status").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Visible = False
' Work screen settings
Sheets("Work").Visible = True
Sheets("Work").Select
ActiveWindow.DisplayHeadings = False
ActiveSheet.Visible = False
' Logic screen settings
Sheets("Logic").Visible = False
Sheets("Payroll_Entry").Select
End Sub

'***************************************************************************
'** SIT F U N C T I O N
'***************************************************************************
Function SIT(Employee, AdjGross)
If IsError(Employee) Then SIT = 0: Exit Function
ConvFactor = PayFrequencyAnnualConvFactor(Employee)
AnnualGross = (AdjGross * ConvFactor) - _
(Range("Employee_List!A5").Offset(Employee, EL_STATE_ALLOW - 1) *
2250)
If Range("Employee_List!A5").Offset(Employee, EL_STATUS - 1) = "Single"
Then
If AnnualGross <= 3000 Then
Table = 0
ElseIf AnnualGross <= 18000 Then
Table = (AnnualGross - 3000) * 0.035
ElseIf AnnualGross <= 33000 Then
Table = 525 + ((AnnualGross - 18000) * 0.0625)
Else
Table = 1462.5 + ((AnnualGross - 33000) * 0.0645)
End If
Else
If AnnualGross <= 6000 Then
Table = 0
ElseIf AnnualGross <= 36000 Then
Table = (AnnualGross - 6000) * 0.035
ElseIf AnnualGross <= 66000 Then
Table = 1050 + ((AnnualGross - 36000) * 0.0625)
Else
Table = 2925 + ((AnnualGross - 66000) * 0.0645)
End If
End If
SIT = -Application.Round((Table / ConvFactor) + _
Range("Employee_List!A5").Offset(Employee, EL_EXTRA_SIT - 1), 2)
End Function

'***************************************************************************
'** SortByCustomer P R O C E D U R E
'***************************************************************************
Sub SortByCustomer()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Select
Sheets("Payroll_Entry").Unprotect
Range("PE_Data").Sort Key1:=Range("L8"), Order1:=xlAscending,
Key2:=Range _
("F8"), 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

'***************************************************************************
'** SortByBillRate P R O C E D U R E
'***************************************************************************
Sub SortByBillRate()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Select
Sheets("Payroll_Entry").Unprotect
Range("PE_Data").Sort Key1:=Range("K8"), Order1:=xlAscending,
Key2:=Range _
("L8"), 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

'***************************************************************************
'** SortByDate P R O C E D U R E
'***************************************************************************
Sub SortByDate()
Application.ScreenUpdating = False
Sheets("Payroll_Entry").Select
Sheets("Payroll_Entry").Unprotect
Range("PE_Data").Sort Key1:=Range("F8"), 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

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

 

[Gretchen Hembree]

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=type,field=custom1,field=inactive")
' PAWData = DDERequest(Channel,
"file=customer,first,field=key,field=name,field=resalenumber,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=type,field=custom1,field=inactive")
' PAWData = DDERequest(Channel,
"file=customer,next,field=key,field=name,field=resalenumber,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=filingstatus,field=frequency,field=allowances,field=extrafit,field=stateallowances,field=gross,ytd,field=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=filingstatus,field=frequency,field=allowances,field=extrafit,field=stateallowances,field=gross,ytd,field=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" & 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

 

[K Dales]

Thanks for posting the code: it is very long and complex! I can only make a
few observations since, firstly, I don't have the time to do extensive
debugging, secondly, I don't have any way to test the setup (I don't have or
know much about Peachtree) and finally, the use of Dynamic Data Exchange
(DDE) is something I am only slightly experienced with. But I can perhaps
provide some info to help your IT staff work on this.

The VBA code here is using DDE to access Peachtree. DDE is a way for
applications to share data. Here is one example of where the code invokes
DDE, from the GenerateInvoice function (there are similar instances in most
of the "GenerateXxxx" functions):

On Error GoTo ErrorHandler ' Enable error-handling routine.
' Channel = Application.DDEInitiate("PeachW", COMPANY)
' DDEPoke Channel, "Password", Range("PWord")

Then the error handler gives the error message you are seeing:

ErrorHandler: ' Error-handling routine.
Sheets("Status").Visible = False
Sheets("Payroll_Calc").Select
MsgBox ("The Peachtree accounting program must be running in the
background before running this function. Start Peachtree then try again.")

Now, in DDE you first establish communication with the other application by
setting up a channel - that is what the Channel = Application.DDEInitiate()
line is trying to do. Then it uses DDEPoke statements to send information or
instructions to the other app, or a DDERequest to get data from it.

It is erroring out somewhere in that process - I suspect it is in the
DDEInitiate statement. Don't know what may have changed in XP that would
affect this, or if maybe it is something different in the machine setup that
makes it not find Peachtree when it looks for it. For example, the
DDEInitiate refers to Peachtree only as "PeachW" - no path, no extension -
does the XL setup recognize this? Is Peachtree in the default file path? If
that changed, perhaps that is why it can't find it.

For more info, here is a link to the DDE section of the MSDN library
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbaxl10/html/xlmthDDEInitiate.asp

Sorry I can't do more, hope this contributes at least something to help
others find the solution!

 

[DM Unseen]

Maybe "Ignore Other apps" on Tools->general is checked. This is an DDE
blocking feature of Excel

Dm Unseen.