Help my code is running very slowly..

Difficult to comment with certainty without seeing the request in the context of its workbook but avoid a loop and consider using Autofilter to first filter the rows you're trying to update and then add the relevant formulae to the filtered rows before removing the autofilter.

There's nothing particularly obvious in your code that's slowing things down.

Hard to find a good answer without seeing the workbook:

Are there many complex / volatile formuale? I'd suggest switching calculation to manual before running your code, then switch back to automatic (if necessary) afterwards, see if that helps speed things up.

Are there any workbook / worksheet change events being triggered by every value change? If so, try disabling application events.

And as always, disabling screenupdating helps speed things up.


To summarise:

With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
End With

'your code

With Application
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True

Reading and writing cell by cell won't be quick. You can speed it up using arrays like this:

    Dim MyLastRow As Long, x As Long, y As Long, w As Long, z As Long   ' Set Variables
    Dim sWBU As Worksheet, sWBUT As Worksheet    ' Set worksheet abbreviations
    Dim varConctnt            As Variant
    Dim vIn, vOut

    Sheets.Add.Name = "Forecast"                        ' Add new sheet called "FORCAST"
    Set sWBU = Worksheets("2014")                      ' Name of worksheets for data source
    Set sWBUT = Worksheets("Forecast")                ' Name of worksheets for data destination

    MyLastRow = sWBU.UsedRange.Rows.Count        ' Find Final Row in dataset
    varConctnt = "FR-25-UK-"                          ' Used to concatenate text cell value

    vIn = sWBU.Range(sWBU.Cells(30, 1), sWBU.Cells(MyLastRow, 157)).Value2
    ReDim vOut(1 To MyLastRow - 29, 1 To 27)

    x = 1     ' Start row to copy to
    w = 1    ' Start Column to copy to
    z = 9     ' Start column to copy from

    For y = 1 To MyLastRow - 29                                  ' first row of the source data
        If Not IsEmpty(vIn(y, 9)) Then
            vOut(x, w) = varConctnt & vIn(y, z) & "-URF"    ' This concatenate the AA & nominal code
            vOut(x, 3) = vIn(y, 11)     ' Project
            vOut(x, 2) = vIn(y, 13)     ' Source
            vOut(x, 4) = vIn(y, 42)     ' Jan of first year
            vOut(x, 5) = vIn(y, 47)     ' Feb of first year
            vOut(x, 6) = vIn(y, 52)     ' Mar of first year
            vOut(x, 7) = vIn(y, 57)     ' Apr of first year
            vOut(x, 8) = vIn(y, 62)     ' May of first year
            vOut(x, 9) = vIn(y, 67)     ' Jun of first year
            vOut(x, 10) = vIn(y, 72)    ' Jul of first year
            vOut(x, 11) = vIn(y, 77)    ' Aug of first year
            vOut(x, 12) = vIn(y, 82)    ' Sep of first year
            vOut(x, 13) = vIn(y, 87)    ' Oct of first year
            vOut(x, 14) = vIn(y, 92)    ' Nov of first year
            vOut(x, 15) = vIn(y, 97)    ' Dec of first year
            vOut(x, 16) = vIn(y, 102)   ' Jan of 2nd year
            vOut(x, 17) = vIn(y, 107)   ' Feb of 2nd year
            vOut(x, 18) = vIn(y, 112)   ' Mar of 2nd year
            vOut(x, 19) = vIn(y, 117)   ' Apr of 2nd year
            vOut(x, 20) = vIn(y, 122)   ' May of 2nd year
            vOut(x, 21) = vIn(y, 127)   ' Jun of 2nd year
            vOut(x, 22) = vIn(y, 132)   ' Jul of 2nd year
            vOut(x, 23) = vIn(y, 137)   ' Aug of 2nd year
            vOut(x, 24) = vIn(y, 142)   ' Sep of 2nd year
            vOut(x, 25) = vIn(y, 147)   ' Oct of 2nd year
            vOut(x, 26) = vIn(y, 152)   ' Nov of 2nd year
            vOut(x, 27) = vIn(y, 157)   ' Dec of 2nd year

            x = x + 1
        End If
    Next y
    sWBUT.Cells(2, 1).Resize(UBound(vOut, 1), UBound(vOut, 2)).Value2 = vOut
    varConctnt = ""

Originally Posted by apo

@Rory.. any advice on whether doing it like this is better/worse?

I doubt it will be significantly different - there may be an additional loop and function call in there but the same amount of data has to be processed either way.

Try this

Sub Macro1()

Dim MyLastRow As Long, x As Long, y As Long, w As Long, z As Long, T As Long   ' Set Variables
Dim sWBU As Worksheet, sWBUT As Worksheet    ' Set worksheet abbreviations
Dim varConctnt As Variant

Sheets.Add.Name = "Forecast"                        ' Add new sheet called "FORCAST"
Set sWBU = Worksheets("2014")                      ' Name of worksheets for data source
Set sWBUT = Worksheets("Forecast")                ' Name of worksheets for data destination

MyLastRow = sWBU.UsedRange.Rows.Count        ' Find Final Row in dataset
varConctnt = "FR-25-UK-"                          ' Used to concatenate text cell value

x = 2     ' Start row to copy to
w = 1    ' Start Column to copy to
z = 9     ' Start column to copy from
For y = 30 To MyLastRow                                  ' first row of the source data
If Not IsEmpty(sWBU.Cells(y, 9)) Then
sWBUT.Cells(x, w).Value = varConctnt & sWBU.Cells(y, z).Value & "-URF"    ' This concatenate the AA & nominal code
             
        x = x + 1
        z = 9
        w = 1
    End If
Next y

sWBUT.Range(Cells(2, 3), Cells(MyLastRow - 30 + 2, 3)).Value = sWBU.Range(Cells(30, 11), Cells(MyLastRow, 11)).Value
sWBUT.Range(Cells(2, 2), Cells(MyLastRow - 30 + 2, 2)).Value = sWBU.Range(Cells(30, 13), Cells(MyLastRow, 13)).Value

For T = 4 To 27
sWBUT.Range(Cells(2, T), Cells(MyLastRow - 30 + 2, T)).Value = sWBU.Range(Cells(30, 42 + (T - 4) * 5), Cells(MyLastRow, 42 + (T - 4) * 5)).Value
Next T

varConctnt = ""

End Sub