Improving Speed of VBA Code - Copy/paste two sets of variable, Excel does a calculation, returns a value then copy/paste the output value

Question

I am attaching the code here. I am very new to VBA and trying to do a complex calculation using Macro. Please help me improve the speed of the attached code. The code works fine and produces the end output. The program is intended to do the following. I am calling the below two subs after data is filled in the sheet. Copy and paste two sets of variable in two specified cell Excel does a complex calculation using FILTER command & other INDEX and MATCH Formulas Copy and paste the output to a location This is required to done 1500 times for two sets of data. Present execution time is 10 minutes.

Sub CF_Amb_Pr_NG()
Dim intX As Integer
Dim copyRng As String
X = 43
For X = 40 To 1539
    Sheets("CC_NG_APr").Select
    Range("C2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R" & X & "C2"
    Range("C3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R" & X & "C3"
    Range("E2").Select
    Selection.Copy
    Let copyRng = "D" & X
    Range(copyRng).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next X
End Sub

Sub CF_RH_NG()
Dim intX As Integer
Dim copyRng As String
X = 33
For X = 32 To 1531
    Sheets("CC_NG_RH").Select
    Range("C2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R" & X & "C2"
    Range("C3").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R" & X & "C3"
    Range("E2").Select
    Selection.Copy
    Let copyRng = "D" & X
    Range(copyRng).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Next X
End Sub

Attached screenshot of sheet in formula mode to explain what exactly is going on in E2 based on the values fed in C2 & C3. Basis the value entered in C2 & C3, formula to be chosen to calculate E2 is chosen and final value is shown. I need to get value in E2 for 3000 sets of data in C2 & C3

Thanks a lot for helping !

Answer 1

As best I can tell, Sub CF_Amb_Pr_NG() sets cells C2 and C3 to formulas that changes with each iteration through the loop, then ends with them set to "=R1539C2".

You then copy cell E2 to each row in column D from 40 to 1539.

Unless there's something going on with the value in C2 and C3 that somehow impact E2, if you really want to stick with the .Select and .PasteSpecial this should do the trick:

Sub test()

  With ThisWorkbook.Worksheets("Sheet1")
    .Range("E2").Select
    Selection.Copy
    .Range("D40:D1539").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    .Range("C2").FormulaR1C1 = "=R1539C2"
    .Range("C3").FormulaR1C1 = "=R1539C3"
  End With

End Sub

Otherwise, I'd suggest this which is even easier:

Sub test()

  With ThisWorkbook.Worksheets("Sheet1")
    .Range("d40:d1539").Value2 = .Range("e2").Value2
    .Range("C2").FormulaR1C1 = "=R1539C2"
    .Range("C3").FormulaR1C1 = "=R1539C3"
  End With

End Sub

It copies E2 to D40 through D1539, then it sets C2 and C3 to the final values they have in your loop.

Make a similar change to Sub CF_RH_NG().

---

If the value in E2 changes with the values as determined in C2 and C3 for each iteration through the loop, I'd strongly suggest that you add a helper column (out in column Z or LLL or someplace) that calculates E2 for the current row, then simply make the formula in D40 read =LLL40 (manually copy that formula down to D1539 one time), and be done with it - no need for code at all.

---

These simple assignments should execute in a second or two (Excel is notably slow in copying in my recent experience), but significantly less than the 10 minutes you're currently experiencing.

---

Based on the update, a loop is required, avoiding .Select will still help performance:

Sub test()

  On Error GoTo CleanExit
'  Application.ScreenUpdating = False
  Dim row As Long
  For row = 40 To 1539
    With Sheet1
      .Range("C2").FormulaR1C1 = "=R" & CStr(row) & "C2"
      .Range("C3").FormulaR1C1 = "=R" & CStr(row) & "C3"
      .Range.Cells.Item(4, row).Value2 = .Range("e2").Value2
    End With
  Next
  
CleanExit:
  Application.ScreenUpdating = True
  
End Sub

Note in this case the With Sheet1 - you can use the worksheet's (Name) property as a direct reference to it (you'll have to modify this for your Workbook):

Note that this is not the same as the .Name of the worksheet as displayed on the "tab":

Additionally, I've added Application.ScreenUpdating = False, but left it commented out for now. Make sure your new code is working properly before enabling this. This will prevent Excel from refreshing the screen with each step it takes. Removing all the UI activity reduces the amount of execution time (it's not a panacea, though). Note the addition of the On Error Goto... to ensure that if anything were to go wrong during execution, it will reenable ScreenUpdating. If you don't weird and confusing things happen.

Answer 2

Thanks a lot @freeman & the community !! Implemented solution by @freeman with the below with a single line change. Could not get to work the .Range.Cells.Item(4, row).Value2 = .Range("e2").Value2 changed this to .Range(pst_row).Value2 = .Range("e2").Value2 added one more variable pst_row rest it works like charm. Runtime < 10 seconds. Also disabled screen update.

Dim row As Long
  Dim pst_row As String
  For row = 42 To 1541
    With Sheet3
    Let pst_row = "D" & row
      .Range("C2").FormulaR1C1 = "=R" & CStr(row) & "C2"
      .Range("C3").FormulaR1C1 = "=R" & CStr(row) & "C3"
      .Range(pst_row).Value2 = .Range("e2").Value2
    End With
  Next
End Sub