Vba far loop too slow

[s20011301]

For i = 1 To 18
For j = 1 To 31

Sheets("ABS").Cells(i, j + 1).Value = 
Workbooks(getfilename).Sheets(orgsheet).Cells(i * 15 - 9, 8 + j).Value + _
Workbooks(getfilename).Sheets(orgsheet).Cells(i * 15 + 3, 8 + j).Value

Next j
Next i

It took 8 seconds to finish. How to improve the codes?

[mdmackillop]

I don't know what else is going on. This took 0.074 seconds with integers and 0.14 seconds with 16 significant figures

Sub Test()
tim = Timer
getfilename = "Data.xlsx"
orgsheet = "Sheet1"
With Workbooks(getfilename).Sheets(orgsheet)
For i = 1 To 18
For j = 1 To 31
Worksheets("ABS").Cells(i, j + 1).Value = _
.Cells(i * 15 - 9, 8 + j).Value + _
.Cells(i * 15 + 3, 8 + j).Value
Next j
Next i
End With
MsgBox Timer - tim
End Sub

[Leith Ross]

Hello s20011301,

Here is another method you can try. This first reads all the values into an array that is 18 x 31. The output range is resized to match the array and the array is output to the range in a single block transfer. With a small data set like this, you may not see any real speed again. However, with larger data sets you can see significant gains.

If you have formulas, did you set formula calculation to manual before running your macro?

Sub TestA()


    Dim Data    As Variant
    Dim dstWks  As Worksheet
    Dim i       As Long
    Dim j       As Long
    Dim srcWkb  As Workbook
    Dim srcWks  As Worksheet
    
    
        Set srcWkb = Workbooks(getfilename)
        Set srcWks = srcWkb.Worksheets(orgsheet)
        
        Set dstWks = ThisWorkbook.Worksheets("ABS")
        
            ReDim Data(1 To 18, 1 To 31)
            
            For i = 1 To 18 * 15 Step 15
                For j = 9 To 39
                    Data(i, j) = srcWks.Cells(i - 9, j) + srcWks.Cells(i + 3, j)
                Next j
            Next i
            
        dstWks.Cells(1, 2).Resize(18, 31).Value = Data


End Sub

[mana]

Application.Calculation = xlCalculationManual
your code
Application.Calculation = xlCalculationAutomatic

[snb]

Sub M_snb()
  sheets("ABS").[A1:AD255]=[org!I6:AM261+org!I18:AM273]
End sub

[p45cal]

mdmackillop's 'I don't know what else is going on' is probably calculations as the destination sheet has values added to it cell by cell, so mana's suggestion will probably suffice.
Leith Ross' suggestion should be very fast since it plonks all the new data in place in one shot, however it still picks the data off the source sheet cell by cell resulting in many sheet accesses which might slow things up, albeit only a little.
It would be faster to have one read access and one write access for the whole process, something along the lines of:

sce = Workbooks(getfilename).Sheets(orgsheet).Range("I6:AM273").Value 'one read access
Dim res(1 To 18, 1 To 31)
rw = 1
For r = 1 To UBound(sce) Step 15
  For c = 1 To 31
    res(rw, c) = sce(r, c) + sce(r + 12, c)
  Next c
  rw = rw + 1
Next r
Sheets("ABS").Range("B1:AF18") = res 'one write access

Time trials support this.
snb's won't work well since the OP needs every 15th row of [org!I6:AM261+org!I18:AM273], not every row.

[s20011301]

Thank you all of you. I find out the main reason is I haven't set formula calculation to manual.