Hi Doug,
it would be much faster to work with arrays of values rather than with
formulae one cell at a time.
Get the values into a variant containing an array:
dim vCalc4 as variant
dim vSummary as variant
Application.screenupdating=false
application.calculation=xlcalculationmanual
vCalc4=Worksheets("Calc4").Range("E3:CV400")
vSummary=Worksheets("Summary").range( ?????, ?????) ''' dont know what size
this is
.... do your calculations using the arrays
.... store the summary array
Worksheets("Summary").range( ?????, ?????) =vSummary
Application.screenupdating=false
application.calculation=xlcalculationmanual
You could use Conditional formatting to control the colours of the cells.
You will need to work out the indexing logic for the summary array as a
replacement for your address calculations.
Using this technique will probably get you to seconds rather than hours, but
if you still need to go faster,
you can speed up your string calculations using Mid$ rather than
Right(left)), or it would be significantly faster to assign the string to a
byte array and index the characters directly.
Charles
______________________
Decision Models
FastExcel 2.3 now available
Name Manager 4.0 now available
www.DecisionModels.com
"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