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