Poor performance in summing up values on another worksheet
Doug,
You haven't decaled any of you variables, so it is hard to know what you
mean by statements like;
vCurrAddr1 = vAddress + "5"
You will find it faster NOT to .select the cells in the range:
c.Interior.ColorIndex = xlNone
You will always find string manipualtion slow, compared to numeric
processing.
So if you must use all those Right, Left, Mid functions because of the way
you data is displayed ("F1-134456/345678"), you may have no choice.
However, using a delimter in the list ("3,4,5,6,7,8") would let you Split
and get all values at the same time.
Whilst impact on perfomanec as such may be neutral, a couple of points may
make you code easier to work with.
Use arrays
Dim vCurrAddr( 1 to 6) As string
Dim vPrefAddr( 1 to 6) As string
Using custom types
Public Type Manning
TradesMen As Long
ApprenticeY4 As Long
ApprenticeY3 As Long
ApprenticeY2 As Long
ApprenticeY1 As Long
ProcessWorker As Long
End Type
Dim Curr As Manning
Dim Pref As Manning
Just a few ideas anyway.
NickHK
"Doug" wrote in message
...
HI there,
The following code takes 4 seconds per cell to complete the four lines
between Message Box C and D or between D and E. These lines total from the
current worksheet (Calc4) into another worksheet (Summary). I have tried
to
tune the code as best possible. If anyone knows of a funtion or a better
way
that I can achieve this, it would be greatly appreciated. This will take 8
hours to run as it stands.
DATA DEFINITION
1 Excel spreadsheet with one worksheet called Calc4 and one called
Summary
2.Sample Values in Calc 4 cells are (F1-134456/345678 or
F2-454566/456743)
SUBROUTINE
Sub SetManning()
Worksheets("Calc4").Select
For Each c In Worksheets("Calc4").Range("E3:CV400").Cells
v_Value = c.Value
c.Select
Selection.Interior.ColorIndex = xlNone
If (Left(v_Value, 2) = "F1" Or Left(v_Value, 2) = "F2") Then
If Len(c.Address) = 4 Then
vAddress = Left(c.Address, 3)
Else
vAddress = Left(c.Address, 4)
End If
' Current manning - Set variables to the cell value
vCurrTradesMen = Right(Left(v_Value, 4), 1)
vCurrApprenticeY4 = Right(Left(v_Value, 5), 1)
vCurrApprenticeY3 = Right(Left(v_Value, 6), 1)
vCurrApprenticeY2 = Right(Left(v_Value, 7), 1)
vCurrApprenticeY1 = Right(Left(v_Value, 8), 1)
vCurrProcessWorker = Right(Left(v_Value, 9), 1)
' Preferred Manning - Set variables to the cell value
vPrefTradesMen = Right(Left(v_Value, 11), 1)
vPrefpprenticeY4 = Right(Left(v_Value, 12), 1)
vPrefApprenticeY3 = Right(Left(v_Value, 13), 1)
vPrefApprenticeY2 = Right(Left(v_Value, 14), 1)
vPrefApprenticeY1 = Right(Left(v_Value, 15), 1)
vPrefprocessWorker = Right(Left(v_Value, 16), 1)
'Fit Out 1 - Yellow
If Left(v_Value, 2) = "F1" Then
c.Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
vCurrAddr1 = vAddress + "5"
vCurrAddr2 = vAddress + "6"
vCurrAddr3 = vAddress + "7"
vCurrAddr4 = vAddress + "8"
vCurrAddr5 = vAddress + "9"
vCurrAddr6 = vAddress + "10"
vPrefAddr1 = vAddress + "29"
vPrefAddr2 = vAddress + "30"
vPrefAddr3 = vAddress + "31"
vPrefAddr4 = vAddress + "32"
vPrefAddr5 = vAddress + "33"
vPrefAddr6 = vAddress + "34"
Else
c.Select
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
vCurrAddr1 = vAddress + "12"
vCurrAddr2 = vAddress + "13"
vCurrAddr3 = vAddress + "14"
vCurrAddr4 = vAddress + "15"
vCurrAddr5 = vAddress + "16"
vCurrAddr6 = vAddress + "17"
vPrefAddr1 = vAddress + "36"
vPrefAddr2 = vAddress + "37"
vPrefAddr3 = vAddress + "38"
vPrefAddr4 = vAddress + "39"
vPrefAddr5 = vAddress + "40"
vPrefAddr6 = vAddress + "41"
End If
MsgBox ("C")
' Current manning - Set variables to the cell value
Worksheets("Summary").Range(vCurrAddr1).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr1).Value + vCurrTradesMen
Worksheets("Summary").Range(vCurrAddr2).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr2).Value + vCurrApprenticeY4
Worksheets("Summary").Range(vCurrAddr3).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr3).Value + vCurrApprenticeY3
Worksheets("Summary").Range(vCurrAddr4).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr4).Value + vCurrApprenticeY2
Worksheets("Summary").Range(vCurrAddr5).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr5).Value + vCurrApprenticeY1
Worksheets("Summary").Range(vCurrAddr6).FormulaR1C 1 =
Worksheets("Summary").Range(vCurrAddr6).Value + vCurrProcessWorker
MsgBox ("D")
' Preferred Manning - Set variables to the cell value
Worksheets("Summary").Range(vPrefAddr1).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr1).Value + vPrefTradesMen
Worksheets("Summary").Range(vPrefAddr2).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr2).Value + vPrefApprenticeY4
Worksheets("Summary").Range(vPrefAddr3).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr3).Value + vPrefApprenticeY3
Worksheets("Summary").Range(vPrefAddr4).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr4).Value + vPrefApprenticeY2
Worksheets("Summary").Range(vPrefAddr5).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr5).Value + vPrefApprenticeY1
Worksheets("Summary").Range(vPrefAddr6).FormulaR1C 1 =
Worksheets("Summary").Range(vPrefAddr6).Value + vPrefprocessWorker
MsgBox ("E")
End If
Next
End Sub
|