Loop running really slow...?

B

Buffyslay

hi all -

am running some code and its ****really**** slow.... why???


****************************
Sub AA_updateSalaries()

Dim i, j, k, m, n, p As Integer
Dim strForm1, strForm2, strForm3, strForm4, strForm5, strForm6,
strForm7
Dim strCC, sOut As String



Dim strForm1a, strForm1b, strForm1c, strForm1d
Dim iFileNum As Integer
Dim lRowCount As Long
Dim lRow As Long
Dim iColCount As Integer
Dim iCol As Integer
Dim Arr()
Workbooks("2007 Budget GDAA.xls").Activate

Worksheets("Salaries").Select

Sheets("SRD").Select
Range("B6").Select
lRowCount = ActiveSheet.UsedRange.Rows.Count
iColCount = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False

'Dim aEmpDetails As Variant 'MUST be variant, no brackets
'aEmpDetails = Range("B6").Resize(lRowCount, 2)
'Range("B18").Resize(lRowCount, 2) = aEmpDetails
j = lRowCount - 5
k = 18
Dim strMess



ReDim Arr(1 To j, 1 To k)

Range("B6").Select
For i = 1 To j
For k = 1 To 18
Arr(i, k) = ActiveCell.Value
ActiveCell.Interior.ColorIndex = 40
strMess = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Next k
ActiveCell.Offset(1, -18).Select
ActiveCell.Interior.ColorIndex = 44
Next i


Worksheets("Salaries").Select

Range("B4").Select

For m = 1 To j
If Arr(m, 1) = "" Then
Else

ActiveCell.Value = Arr(m, 1)
ActiveCell.Offset(0, 1).Select
strMess = ActiveCell.Value
ActiveCell.Value = Arr(m, 2)
ActiveCell.Offset(0, 1).Select

strForm1a = "=IF(AND((MONTH(" & Chr(34) & Arr(m, 9) & Chr(34) & ")<="
strForm1b = "),(MONTH(" & Chr(34) & Arr(m, 10) & Chr(34) & ")>="
strForm1c = ")),"


' salary
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm2 = strForm1 & Arr(m, 3) & ",0)"
ActiveCell.Formula = strForm2
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n

ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL01"
ActiveCell.Offset(1, -12).Select

' shift
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & Arr(m, 6) & ",0)"
ActiveCell.Formula = strForm3
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select

Next n
ActiveCell.Interior.ColorIndex = 24

ActiveCell.Offset(0, 1).Value = "SAL01"
ActiveCell.Offset(1, -12).Select


' pension
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & "Round(Pension_Rate*" & Arr(m, 3) &
",0),0)"
ActiveCell.Formula = strForm3

ActiveCell.Offset(0, 1).Select
ActiveCell.Interior.ColorIndex = 24

Next n
ActiveCell.Interior.ColorIndex = 24

ActiveCell.Offset(0, 1).Value = "SAL05"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' PHI
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & "Round(PHI_Amount_pa/12,0),0)"
ActiveCell.Formula = strForm3
ActiveCell.Offset(0, 1).Select
ActiveCell.Interior.ColorIndex = 24
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL20"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


' NI
For n = 1 To 12
strForm7 = strForm1a & n & strForm1b & n & strForm1c
p = Arr(m, 3) + Arr(m, 6) + Arr(m, 7) + Arr(m, 5)
strForm7 = strForm7 & p & "*NI_Rate,0)"
' MsgBox strForm7
ActiveCell.Formula = strForm7
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL05"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Sports
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & "SportSocial_ph,0)"
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL10"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Bonus / Retention
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 5) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL20"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Mobile Phones
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 7) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL04"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


' Overtime
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 3) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL02"
ActiveCell.Offset(1, -12).Select


' Acquisition Costs
For n = 1 To 12
strForm1a = "=IF(MONTH(" & Chr(34) & Arr(m, 9) & Chr(34) & ")="
& n & ","
ActiveCell.Formula = strForm1a & Arr(m, 8) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL02"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


ActiveCell.Offset(0, -2).Select
End If
Next m


Application.ScreenUpdating = True
MsgBox "Done"
End Sub
 
P

paul.robinson

Hi
It is probably all the selecting you are doing
e.g.
ActiveCell.Offset(1, -18).Select
ActiveCell.Interior.ColorIndex = 44

can be replaced with
ActiveCell.Offset(1, -18).Interior.ColorIndex = 44

Try doing similar replacements throughout your code to eliminate as
many selects as you can (ideally all of them!!)
regards
Paul
hi all -

am running some code and its ****really**** slow.... why???


****************************
Sub AA_updateSalaries()

Dim i, j, k, m, n, p As Integer
Dim strForm1, strForm2, strForm3, strForm4, strForm5, strForm6,
strForm7
Dim strCC, sOut As String



Dim strForm1a, strForm1b, strForm1c, strForm1d
Dim iFileNum As Integer
Dim lRowCount As Long
Dim lRow As Long
Dim iColCount As Integer
Dim iCol As Integer
Dim Arr()
Workbooks("2007 Budget GDAA.xls").Activate

Worksheets("Salaries").Select

Sheets("SRD").Select
Range("B6").Select
lRowCount = ActiveSheet.UsedRange.Rows.Count
iColCount = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False

'Dim aEmpDetails As Variant 'MUST be variant, no brackets
'aEmpDetails = Range("B6").Resize(lRowCount, 2)
'Range("B18").Resize(lRowCount, 2) = aEmpDetails
j = lRowCount - 5
k = 18
Dim strMess



ReDim Arr(1 To j, 1 To k)

Range("B6").Select
For i = 1 To j
For k = 1 To 18
Arr(i, k) = ActiveCell.Value
ActiveCell.Interior.ColorIndex = 40
strMess = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
Next k
ActiveCell.Offset(1, -18).Select
ActiveCell.Interior.ColorIndex = 44
Next i


Worksheets("Salaries").Select

Range("B4").Select

For m = 1 To j
If Arr(m, 1) = "" Then
Else

ActiveCell.Value = Arr(m, 1)
ActiveCell.Offset(0, 1).Select
strMess = ActiveCell.Value
ActiveCell.Value = Arr(m, 2)
ActiveCell.Offset(0, 1).Select

strForm1a = "=IF(AND((MONTH(" & Chr(34) & Arr(m, 9) & Chr(34) & ")<="
strForm1b = "),(MONTH(" & Chr(34) & Arr(m, 10) & Chr(34) & ")>="
strForm1c = ")),"


' salary
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm2 = strForm1 & Arr(m, 3) & ",0)"
ActiveCell.Formula = strForm2
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n

ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL01"
ActiveCell.Offset(1, -12).Select

' shift
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & Arr(m, 6) & ",0)"
ActiveCell.Formula = strForm3
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select

Next n
ActiveCell.Interior.ColorIndex = 24

ActiveCell.Offset(0, 1).Value = "SAL01"
ActiveCell.Offset(1, -12).Select


' pension
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & "Round(Pension_Rate*" & Arr(m, 3) &
",0),0)"
ActiveCell.Formula = strForm3

ActiveCell.Offset(0, 1).Select
ActiveCell.Interior.ColorIndex = 24

Next n
ActiveCell.Interior.ColorIndex = 24

ActiveCell.Offset(0, 1).Value = "SAL05"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' PHI
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
strForm3 = strForm1 & "Round(PHI_Amount_pa/12,0),0)"
ActiveCell.Formula = strForm3
ActiveCell.Offset(0, 1).Select
ActiveCell.Interior.ColorIndex = 24
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL20"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


' NI
For n = 1 To 12
strForm7 = strForm1a & n & strForm1b & n & strForm1c
p = Arr(m, 3) + Arr(m, 6) + Arr(m, 7) + Arr(m, 5)
strForm7 = strForm7 & p & "*NI_Rate,0)"
' MsgBox strForm7
ActiveCell.Formula = strForm7
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL05"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Sports
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & "SportSocial_ph,0)"
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Interior.ColorIndex = 24
ActiveCell.Offset(0, 1).Value = "SAL10"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Bonus / Retention
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 5) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL20"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select

' Mobile Phones
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 7) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL04"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


' Overtime
For n = 1 To 12
strForm1 = strForm1a & n & strForm1b & n & strForm1c
ActiveCell.Formula = strForm1 & Arr(m, 3) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL02"
ActiveCell.Offset(1, -12).Select


' Acquisition Costs
For n = 1 To 12
strForm1a = "=IF(MONTH(" & Chr(34) & Arr(m, 9) & Chr(34) & ")="
& n & ","
ActiveCell.Formula = strForm1a & Arr(m, 8) & ",0)"
ActiveCell.Offset(0, 1).Select
Next n
ActiveCell.Offset(0, 1).Value = "SAL02"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
ActiveCell.Offset(1, -12).Select


ActiveCell.Offset(0, -2).Select
End If
Next m


Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Click to expand...
 
B

Buffyslay

Hi
It is probably all the selecting you are doing
e.g.
ActiveCell.Offset(1, -18).Select
ActiveCell.Interior.ColorIndex = 44

can be replaced with
ActiveCell.Offset(1, -18).Interior.ColorIndex = 44

Try doing similar replacements throughout your code to eliminate as
many selects as you can (ideally all of them!!)
regards
Paul
Click to expand...



so i should do something like:

ActiveCell.Offset(0, 1).Formula = strForm1 & Arr(m, 5) & ",0)"
ActiveCell.Offset(0, 1).Interior = 44

but does that mean it will skip over 2?

can i reference the range? and then pop in the formula?
 
B

Buffyslay

i turned off the calculations

Application.Calculation = xlManual

wow! instant results!!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Array - Object required??? 5
simple little loop 3
Remove a "0" 9
Select contiguous cells by ActiveCell.Interior.ColorIndex and applyborders 13
Need assistance with secondary axis in Excel 2007 0
Looping Macro to scrap multiple pages in Mainframe 2
How to write a for loop to get the range between a ,b columns 4
A workbook of macros which runs on external workbooks. 6

Top