is VBA this slow?

[henrik2h]

OK, if you have seen this macro in another similar question recently, I am a clown and completely messed up my timer so I looked for problem in the wrong place...

I have this macro that place input (number 1 to 100) in a cell and then copy and store the resulting range of outcome in another sheet. It takes 60-70 seconds for 100 inputs (I would like many more).

Just made a macro that does the same, loop through 1 to 100 but I never copy the outcome, it just goes on to the next input (not the one below). That takes 2 seconds!

When it comes to the formulas in the outcome range I have streamlined them in every possible way, there is 'nothing' that can be done further.

Is this the reality of VBA/copying from workbook to VBA, or is it something that I completely mess up?

Sub Calc_to_pivot()

' Calculate all leases and copy to Pivot sheet


    Application.ScreenUpdating = False
    Application.Iteration = False
    
    Dim i As Long, j As Long, Lease_Count As Long, PivotSource As Range, k As Integer, Starttime As Double, TimeElapsed As Double
    Dim arrS As Variant, arrT As Variant, L As Long, Row As Long, istart As Long, msg As String
    
    Set PivotSource = ActiveWorkbook.Sheets("Flow_calculation").Range("AC208:BT251")
    k = 44  ' number of columns (transposed to rows) to offset
    
    Lease_Count = Sheets("INP_PREM").ListObjects("tbRentRoll").DataBodyRange.Rows.Count
    
    ReDim arrS(1 To k, 1 To 44)
    ReDim arrT(1 To Lease_Count * k, 1 To 44)
    
    Sheets("Pivot").Range("A161:AR1000000").ClearContents
    ActiveSheet.DisplayPageBreaks = False
            
     ' turn off automatic calculation except for "Flow_calculation"
     Application.Calculation = xlCalculationManual
     
     With Sheets("Flow_calculation")
     Application.Calculation = xlCalculationAutomatic
     End With
        
    Sheets("Flow_calculation").Activate

===SLOW, recalculating in Excel 100 times takes 2 sec, in macro 60 sec=== 
    'Calculate for all leases, one by one
    For L = 1 To Lease_Count
    
     'Choose lease from row L
    ActiveSheet.Range("B3").Value = L
    
    ' tranpose range and put in array
    arrS = Application.Transpose(PivotSource.Value2)
    
===Fast, no problem===
    'check for errors
    If ActiveSheet.Range("B207").Value = "ERROR" Then
    msg = "Error in lease row " & L
    MsgBox msg, vbOKOnly, "ERROR"
    Sheets("Pivot").Range("A161:AR1000000").ClearContents
    Sheets("CASH_FLOW").Select
    Range("D31").Select
    Sheets("Lease_analysis").Select
    Range("B9").Select
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub
    End If
===    
===Fast, no problem===    
    istart = (L - 1) * k
    
        For i = 1 To k
        Row = istart + i
            For j = 1 To 44
            arrT(Row, j) = arrS(i, j)
            Next j
        Next i
===
        
    Next L
    
    
===Fast, no problem===    
    ' Paste array of value onto sheet Pivot
    Set Destination = Sheets("Pivot").Range("A161")
    Destination.Resize(UBound(arrT, 1), UBound(arrT, 2)).Value = arrT
    Application.Calculation = xlCalculationAutomatic
===    
    ' resize pivot source data and refresh
    
===ignore this, it is only a few seconds at the end====
Call AdjustPivotDataRange
===    
    Application.ScreenUpdating = True






End Sub