Slow Running Subroutine
 

Do you have any worksheet change code being activated ?
--
If the post is helpful, please consider donating something to an animal
charity on my behalf.


"Steve" wrote:

I have a fairly easy subroutine that takes 18 seconds to run. It should
probably take about .5 seconds. The routine populates a row of data from a
Userform. Any help would be appreciated. Thanks!

Sub UpdatePayrollRcd()
Sheets("PREmp").Select
Worksheets("Control").Unprotect Password:="XYZ"
If func = "Add" Then
Cells(emprow, 1) = newnbr * 1
Payroll.EESearchcmbo = newnbr * 1
Payroll.EENbrtxt = newnbr * 1
Else
Cells(emprow, 1) = Payroll.EENbrtxt * 1
End If
Cells(emprow, 2) = Payroll.EENametxt
Cells(emprow, 15) = Payroll.ActiveYNtxt
Cells(emprow, 10) = Payroll.HireDatetxt
Cells(emprow, 16) = Payroll.TermDatetxt
Cells(emprow, 9) = Payroll.BirthYeartxt * 1
Cells(emprow, 18) = Payroll.VacationMthtxt
Cells(emprow, 11) = Payroll.BaseSalarytxt * 1
Cells(emprow, 21) = Payroll.HousingAllowtxt * 1
Cells(emprow, 27) = Payroll.RespInctxt * 1
Cells(emprow, 24) = Payroll.JobGradetxt
Cells(emprow, 5) = Payroll.Depttxt * 1
Cells(emprow, 6) = Payroll.JobTitletxt
Cells(emprow, 3) = Payroll.UnionYNtxt
Cells(emprow, 4) = Payroll.UnionIDtxt
Cells(emprow, 17) = Payroll.NHIFNbrtxt
Cells(emprow, 8) = Payroll.NSSFNbrtxt
Cells(emprow, 4) = Payroll.PayEEIDtxt
Cells(emprow, 19) = Payroll.Edutxt
Cells(emprow, 20) = Payroll.Certtxt
Cells(emprow, 48) = Payroll.AddNSSFtxt
Cells(emprow, 35) = Payroll.CoopMealstxt * 1
Cells(emprow, 14) = Payroll.Ins1txt * 1
Cells(emprow, 37) = Payroll.Ins2txt * 1
Cells(emprow, 25) = Payroll.PrivIns1txt * 1
Cells(emprow, 36) = Payroll.PrivIns2txt * 1
If Payroll.PayPensionchkbox = True Then
Cells(emprow, 49) = "True"
Else
Cells(emprow, 49) = "False"
End If
Cells(emprow, 50) = Payroll.Pensiontxt * 1
If IsNumeric(Payroll.MaxPensiontxt) = True Then
Cells(emprow, 51) = Payroll.MaxPensiontxt * 1
Else
Cells(emprow, 51) = Payroll.MaxPensiontxt
End If
Cells(emprow, 52) = Payroll.YTDPensiontxt * 1
Cells(emprow, 53) = Payroll.TotalPensiontxt * 1
' Tab 2
If Payroll.PayViaBankchkbox = True Then
Cells(emprow, 40) = "True"
Else
Cells(emprow, 40) = "False"
End If
Cells(emprow, 41) = Payroll.PayBankNametxt
Cells(emprow, 42) = Payroll.BankBranchNametxt
Cells(emprow, 43) = Payroll.BankAccttxt
Cells(emprow, 44) = Payroll.LoanBankNametxt
Cells(emprow, 45) = Payroll.LoanBankBranchtxt
Cells(emprow, 46) = Payroll.LoanBankAccttxt
Cells(emprow, 47) = Payroll.LoanAmttxt * 1
Cells(emprow, 54) = Payroll.MiscCrAmttxt * 1
Cells(emprow, 55) = Payroll.MiscDbAmttxt * 1
Cells(emprow, 56) = Payroll.OTHourstxt * 1
Cells(emprow, 57) = Payroll.AbsHourstxt * 1
Cells(emprow, 58) = Payroll.HolHourstxt * 1
Cells(emprow, 59) = Payroll.BonusAmttxt * 1
If Payroll.CoopAmttxt = "" Then
Cells(emprow, 60) = 0
Else
Cells(emprow, 60) = Payroll.CoopAmttxt * 1
End If
If func = "Add" Then
emprow = emprow + 1
Call ResizeEmpDB
End If
func = ""
End Sub

Slow Running Subroutine
 

On Jan 17, 8:16*am, Paul wrote:
Do you have any worksheet change code being activated ?
--
If the post is helpful, please consider donating something to an animal
charity on my behalf.



"Steve" wrote:
I have a fairly easy subroutine that takes 18 seconds to run. *It should
probably take about .5 seconds. *The routine populates a row of data from a
Userform. Any help would be appreciated. *Thanks!

Sub UpdatePayrollRcd()
Sheets("PREmp").Select
Worksheets("Control").Unprotect Password:="XYZ"
If func = "Add" Then
Cells(emprow, 1) = newnbr * 1
Payroll.EESearchcmbo = newnbr * 1
Payroll.EENbrtxt = newnbr * 1
Else
Cells(emprow, 1) = Payroll.EENbrtxt * 1
End If
Cells(emprow, 2) = Payroll.EENametxt
Cells(emprow, 15) = Payroll.ActiveYNtxt
Cells(emprow, 10) = Payroll.HireDatetxt
Cells(emprow, 16) = Payroll.TermDatetxt
Cells(emprow, 9) = Payroll.BirthYeartxt * 1
Cells(emprow, 18) = Payroll.VacationMthtxt
Cells(emprow, 11) = Payroll.BaseSalarytxt * 1
Cells(emprow, 21) = Payroll.HousingAllowtxt * 1
Cells(emprow, 27) = Payroll.RespInctxt * 1
Cells(emprow, 24) = Payroll.JobGradetxt
Cells(emprow, 5) = Payroll.Depttxt * 1
Cells(emprow, 6) = Payroll.JobTitletxt
Cells(emprow, 3) = Payroll.UnionYNtxt
Cells(emprow, 4) = Payroll.UnionIDtxt
Cells(emprow, 17) = Payroll.NHIFNbrtxt
Cells(emprow, 8) = Payroll.NSSFNbrtxt
Cells(emprow, 4) = Payroll.PayEEIDtxt
Cells(emprow, 19) = Payroll.Edutxt
Cells(emprow, 20) = Payroll.Certtxt
Cells(emprow, 48) = Payroll.AddNSSFtxt
Cells(emprow, 35) = Payroll.CoopMealstxt * 1
Cells(emprow, 14) = Payroll.Ins1txt * 1
Cells(emprow, 37) = Payroll.Ins2txt * 1
Cells(emprow, 25) = Payroll.PrivIns1txt * 1
Cells(emprow, 36) = Payroll.PrivIns2txt * 1
If Payroll.PayPensionchkbox = True Then
Cells(emprow, 49) = "True"
Else
Cells(emprow, 49) = "False"
End If
Cells(emprow, 50) = Payroll.Pensiontxt * 1
If IsNumeric(Payroll.MaxPensiontxt) = True Then
Cells(emprow, 51) = Payroll.MaxPensiontxt * 1
Else
Cells(emprow, 51) = Payroll.MaxPensiontxt
End If
Cells(emprow, 52) = Payroll.YTDPensiontxt * 1
Cells(emprow, 53) = Payroll.TotalPensiontxt * 1
' Tab 2
If Payroll.PayViaBankchkbox = True Then
Cells(emprow, 40) = "True"
Else
Cells(emprow, 40) = "False"
End If
Cells(emprow, 41) = Payroll.PayBankNametxt
Cells(emprow, 42) = Payroll.BankBranchNametxt
Cells(emprow, 43) = Payroll.BankAccttxt
Cells(emprow, 44) = Payroll.LoanBankNametxt
Cells(emprow, 45) = Payroll.LoanBankBranchtxt
Cells(emprow, 46) = Payroll.LoanBankAccttxt
Cells(emprow, 47) = Payroll.LoanAmttxt * 1
Cells(emprow, 54) = Payroll.MiscCrAmttxt * 1
Cells(emprow, 55) = Payroll.MiscDbAmttxt * 1
Cells(emprow, 56) = Payroll.OTHourstxt * 1
Cells(emprow, 57) = Payroll.AbsHourstxt * 1
Cells(emprow, 58) = Payroll.HolHourstxt * 1
Cells(emprow, 59) = Payroll.BonusAmttxt * 1
If Payroll.CoopAmttxt = "" Then
Cells(emprow, 60) = 0
Else
Cells(emprow, 60) = Payroll.CoopAmttxt * 1
End If
If func = "Add" Then
emprow = emprow + 1
Call ResizeEmpDB
End If
func = ""
End Sub- Hide quoted text -

- Show quoted text -

Writing data from VBA to the spreadsheet is very slow, especially if
it triggers a recalculation. I suggest setting up an array in VBA,
filling that, then writing the complete row in one operation.

If you can set up a 2D array, and write the whole table in one
operation, so much the better.