Suggestions on how to speed up loop

Question

I have the following code. I was wondering if there is an easy way to rewrite it so that it takes less time to run? Currently, I have about 13,000 rows to loop through and it takes approximate 3-5 minutes to run. Thanks!

Sheets("wkly").Activate

Dim i As Long

Lastrow = Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Lastrow


If Range("S" & i) > 0.005 Then
        Range("Z" & i, "AA" & i).Copy
        Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If

Application.ScreenUpdating = False
Next i

Answer 1

I believe this will help make it a lot faster. No looping and no copy and paste needed.

Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim wks As Worksheet, Lastrow As Long
Set wks = Sheets("wkly")

With wks

    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    .Range("S1:S" & Lastrow).AutoFilter 1, ">.005"

    'Assumes you will always have values greater than .005, if not you need to error trap
     Dim rngFilter As Range
     Set rngFilter = .Range("S2:S" & Lastrow).SpecialCells(xlCellTypeVisible) 'assumes row 1 is header row

     rngFilter.Offset(, 10).Value = rngFilter.Offset(, 7).Value
     rngFilter.Offset(, 11).Value = rngFilter.Offset(, 8).Value


End With

Application.ScreenUpdating = True

UPDATE I know you accepted the answer already, but in case you want to know how to do this by using an array to loop through, here it is below:

Dim wks As Worksheet, varStore As Variant, Lastrow As Long, i As Long

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set wks = Sheets("wkly")

With wks

    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    varStore = .Range("S2:S" & Lastrow)

    For i = LBound(varStore, 1) To UBound(varStore, 1)

        If varStore(i, 1) > 0.005 Then .Range("AC" & i + 2 & ":AD" & i + 2).Value = .Range("Z" & i + 2 & ":AA" & i + 2).Value

    Next

End With

Application.ScreenUpdating = False

Answer 2

Given all the good tips, and include the following too. Please give a try and see how much performance boost you could achieve.

Application.Calculation = xlCalculationManual

lastrow = Range("S" & Rows.Count).End(xlUp).Rows
For i = 1 To lastrow
    If Range("S1").Offset(i) > 0.005 Then
            Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value
    End If
Next i

Answer 3

If you do operations on a large number of cells, copying them into an array and writing them back after the processing is usually the fastest. The following code runs in 0.04s on my machine (based on Scott's answer, but using arrays also for the writing):

Dim wks As Worksheet
Dim varCompare As Variant, varSource As Variant, varTarget As Variant
Dim Lastrow As Long, i As Long

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set wks = Sheets("wkly")

With wks

    Lastrow = .Range("A" & .Rows.Count).End(xlUp).Row

    varCompare = .Range("S2:S" & Lastrow)
    varSource = .Range("Z2:AD" & Lastrow)
    varTarget = .Range("AC2:AD" & Lastrow)
    For i = LBound(varCompare, 1) To UBound(varCompare, 1)

        If varCompare(i, 1) > 0.005 Then
            varTarget(i, 1) = varSource(i, 1)
            varTarget(i, 2) = varSource(i, 2)
        End If
    Next

    .Range("AC2:AD" & Lastrow).Value = varTarget
End With

Application.ScreenUpdating = False