0
\$\begingroup\$

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

Calculations used in for determining E2' using values for C2&C3`

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 !

\$\endgroup\$
10
  • \$\begingroup\$ Did you post the whole code, or did you post too much ? I don't see where CF_RH_NG is actually used in this code. \$\endgroup\$
    – Anonymous
    May 24 at 13:24
  • \$\begingroup\$ The first procedure is missing the signature and possibly some additional lines of code. \$\endgroup\$
    – FreeMan
    May 24 at 13:27
  • \$\begingroup\$ @Anonymous - I am calling these two subs in the excel to perform calculation after data entry is completed. The calculations are done in two different sheets. \$\endgroup\$
    – bikash.a
    May 24 at 13:32
  • \$\begingroup\$ @FreeMan - Please help here. I am getting the result i need but it takes forever. \$\endgroup\$
    – bikash.a
    May 24 at 13:33
  • \$\begingroup\$ COM and Excel Automation is known to be slow. Writing cell-by-cell is VERY slow. Is there any way you can write to an entire range once rather than individual rows? \$\endgroup\$
    – Rick Davin
    May 24 at 13:36
0
\$\begingroup\$

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):

enter image description here

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

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.

\$\endgroup\$
4
  • \$\begingroup\$ For info on .Value vs .Value2, see this good SO Q&A. \$\endgroup\$
    – FreeMan
    May 24 at 14:06
  • \$\begingroup\$ I don't think this would work. See the thing is the formula to be used to calculate E2 is dependent on the values fed into C2 & C3. Based on the data in C2 & C3, Formula to be used in E2 is chosen and subsequently E2 is calculated. \$\endgroup\$
    – bikash.a
    May 24 at 14:11
  • \$\begingroup\$ Then use the suggestion between the two lines - instead of calculating them in a function, have hard-coded calculations set off to the side somewhere in a hidden/locked column and let Excel just do its thing. \$\endgroup\$
    – FreeMan
    May 24 at 14:14
  • \$\begingroup\$ Added an image of the excel to explain what actually is going on in C2 & C3 to generate E2. I have tried using a helper column but could not make it work. \$\endgroup\$
    – bikash.a
    May 24 at 14:29
0
\$\begingroup\$

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

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.