Running a VBA Macro in Excel has become slower after upgrading to new version

Question

Hi there,

I have been tasked with improving the execution speed of an existing VBA macro (years old), which pulls values (based on rows) from a master list sheet into another (less organized) worksheet for calculation, spits the calculated values onto the end of the row in question, and iterates for the number of rows.

This has been an ongoing issue for at least a couple years since my department's rollout of excel updates. The only workaround we've found so far is rolling back our Excel version to 2002, but this is not sustainable, as IT wants us all on the new version.

Please have a look at the code below and let me know if there is something we might be able to optimize.

Sub Button3_Click()

    'TO SOLVE'


Dim k As Long

'Can disable screenupdating to increase speed of calculation, but it will remove ticker'

Application.Calculation = xManual
Application.PrintCommunication = False

    'Defines sheets'
    Set ws1 = Sheets("Calc inputs/outputs")
    Set ws2 = Sheets("Individual Calc")

    'Clears all filters'
    If ws1.FilterMode Then
        ws1.ShowAllData
    End If

    'Removes factored cell value from ws2'
    ws2.Range("E9").Value = "0"

    'Counts rows in sheet'
    Dim LastRow As Long
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

    'For ticker counter'
    ws1.Range("P3").Value = "OF" & (LastRow - 14)

    For R = 15 To LastRow

        'Copies and pastes base values from ws1 to ws2'
        ws2.Range("C7").Value = ws1.Range("J" & R).Value
        ws2.Range("D7").Value = ws1.Range("K" & R).Value
        ws2.Range("E7").Value = ws1.Range("L" & R).Value
        ws2.Range("F7").Value = ws1.Range("M" & R).Value

        ws2.Range("C20").Value = ws1.Range("N" & R).Value

        ws2.Range("D10").Value = ws1.Range("O" & R).Value
        ws2.Range("E10").Value = ws1.Range("P" & R).Value

        ws2.Range("G7").Value = ws1.Range("U" & R).Value
        ws2.Range("H7").Value = ws1.Range("T" & R).Value

        ws2.Range("I7").Value = ws1.Range("V" & R).Value
        ws2.Range("B7").Value = ws1.Range("G" & R).Value

        ws2.Range("B14").Value = ws1.Range("W" & R).Value
        ws2.Range("C14").Value = ws1.Range("X" & R).Value

        ws2.Range("B52").Value = ws1.Range("Y" & R).Value

        ws2.Range("I51").Value = ws1.Range("Z" & R).Value
        ws2.Range("I53").Value = ws1.Range("AA" & R).Value

        ws2.Range("G39").Value = ws1.Range("AB" & R).Value

        ws2.Range("H39").Value = ws1.Range("AC" & R).Value
        ws2.Range("I39").Value = ws1.Range("AD" & R).Value
        ws2.Range("J39").Value = ws1.Range("AE" & R).Value
        ws2.Range("K39").Value = ws1.Range("AF" & R).Value
        ws2.Range("L39").Value = ws1.Range("AG" & R).Value

        ws2.Range("I12").Value = ws1.Range("AH" & R).Value

        ws2.Range("E18").Value = ws1.Range("AI" & R).Value
        ws2.Range("E19").Value = ws1.Range("AJ" & R).Value

        ws2.Range("E42").Value = ws1.Range("AK" & R).Value
        ws2.Range("F42").Value = ws1.Range("AL" & R).Value

        ws2.Range("E9").Value = ws1.Range("AU" & R).Value
        ws2.Range("E11").Value = ws1.Range("AV" & R).Value

        'Calculates worksheet'
        ws2.Calculate

        'Copies and pastes end values from ws2 to ws1'
        ws1.Range("BA" & R).Value = ws2.Range("G47").Value
        ws1.Range("BD" & R).Value = ws2.Range("G49").Value
        ws1.Range("BG" & R).Value = ws2.Range("G51").Value
        ws1.Range("BJ" & R).Value = ws2.Range("G53").Value

        ws1.Range("BB" & R).Value = ws2.Range("J47").Value
        ws1.Range("BE" & R).Value = ws2.Range("J49").Value
        ws1.Range("BH" & R).Value = ws2.Range("J51").Value
        ws1.Range("BK" & R).Value = ws2.Range("J53").Value

        ws1.Range("BC" & R).Value = ws2.Range("H47").Value
        ws1.Range("BF" & R).Value = ws2.Range("H49").Value
        ws1.Range("BI" & R).Value = ws2.Range("H51").Value
        ws1.Range("BL" & R).Value = ws2.Range("H53").Value

        ws1.Range("BM" & R).Value = ws2.Range("E35").Value

        ws1.Range("BN" & R).Value = ws2.Range("G13").Value

        ws1.Range("CG" & R).Value = ws2.Range("E39").Value

        'Copies and pastes breakdown of end values from ws2 to ws1'
        ws1.Range("BQ" & R).Value = ws2.Range("M47").Value
        ws1.Range("BU" & R).Value = ws2.Range("M49").Value
        ws1.Range("BY" & R).Value = ws2.Range("M51").Value
        ws1.Range("CC" & R).Value = ws2.Range("M53").Value

        ws1.Range("BR" & R).Value = ws2.Range("N47").Value
        ws1.Range("BV" & R).Value = ws2.Range("N49").Value
        ws1.Range("BZ" & R).Value = ws2.Range("N51").Value
        ws1.Range("CD" & R).Value = ws2.Range("N53").Value

        ws1.Range("BS" & R).Value = ws2.Range("O47").Value
        ws1.Range("BW" & R).Value = ws2.Range("O49").Value
        ws1.Range("CA" & R).Value = ws2.Range("O51").Value
        ws1.Range("CE" & R).Value = ws2.Range("O53").Value

        ws1.Range("BT" & R).Value = ws2.Range("P47").Value
        ws1.Range("BX" & R).Value = ws2.Range("P49").Value
        ws1.Range("CB" & R).Value = ws2.Range("P51").Value
        ws1.Range("CF" & R).Value = ws2.Range("P53").Value



    'For ticker counter'
    k = k + 1
    ws1.Range("O3").Value = k

    Next R

    Application.ScreenUpdating = True

Application.Calculation = xlAutomatic
Application.PrintCommunication = True

End Sub

I have tried concatenating the grouped lines (blank spaces are removed internal comments for the most part) using colons, but it didn't really help much...

I also apologize for any formatting issues, the code sample doesn't seem to want to read my copy/paste nicely...

Should you have any questions or require clarification, please let me know.

Any and all help is greatly appreciated!