1

I have written a code that copies a template from one sheet and pastes this in a different sheet with a new variable to trigger the fuctions in the template, I currently have 115 variables that i need and it takes too long with "DoEvents" and without it excel stops responding. Is there any way to optimize the code? At the end i copy and paste as values in order to save space in the file.

Variables stored in "rng"

Code below:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Flight FS").SelectSheets("Flight FS").Range("c1048576").Select
Selection.End(xlUp).Select
Sheets("Flight FS").Range(ActiveCell, Sheets("Flight FS").Range("C6").End(xlToRight)).Select
Selection.Clear

Dim rng As Range, cell As Range

Set rng = Sheets("Flight FS templ").Range("c45", Sheets("Flight FS 
templ").Range("c45").End(xlDown))



For Each cell In rng
Sheets("Flight FS templ").Select
Sheets("Flight FS templ").Range("c6", Sheets("Flight FS 
templ").Range("i40").End(xlToRight)).Select
Selection.Copy
Sheets("Flight FS").Select
Range("c1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate
ActiveSheet.Paste
ActiveCell.Offset(rowoffset:=1, columnoffset:=3).Activate
ActiveCell.Value = cell
DoEvents
Next cell

Application.Calculation = xlCalculationAutomatic
Sheets("Flight FS").Select
Sheets("Flight FS").Range("c1048576").Select
    Selection.End(xlUp).Select
    Sheets("Flight FS").Range(ActiveCell, Sheets("Flight 
FS").Range("C6").End(xlToRight)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

ActiveSheet.Range("A2").Select

Application.CutCopyMode = False

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub
b1man
  • 13
  • 3
  • 4
    Please have a look on [How to avoid using Select](https://stackoverflow.com/q/10714251/17172829). – Shrotter Mar 11 '22 at 08:21
  • `DoEvents` is not a good solution in this case. If Excel stops responding this means the code is still running. Since VBA does not support multi-threading you need to wait until one thin (macro) is done until any other action can be performed. • Therefore get rid of all your `.Select` statements as described in the link above. • If you can [edit] your question and give a example data and explain what your code should do, maybe we can help you to improve the code to find a faster solution too. – Pᴇʜ Mar 11 '22 at 08:36

1 Answers1

1

How to avoid Select

  • Not tested. The code compiles which doesn't mean that it works. Your feedback is appreciated.
  • I don't know what the formulas in the source range are, but they should be calculated in VBA if they are 'slowing down' your workbook.
Option Explicit

Sub GenerateData()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the destination worksheet, reference the last cell,
    ' reference and clear the destination range and reference
    ' the destination last cell (see the offsets later in the code).
    Dim dws As Worksheet: Set dws = wb.Worksheets("Flight FS")
    Dim dCell As Range: Set dCell = dws.Cells(dws.Rows.Count, "C").End(xlUp)
    Dim drg As Range ' (left-bottom, top-right)
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Clear
    Set dCell = drg.Cells(1).Offset(-1)
    
    ' Reference the source worksheet, reference the source column range,
    ' reference the source range and calculate the destination offset.
    Dim sws As Worksheet: Set sws = wb.Worksheets("Flight FS templ")
    Dim scrg As Range
    Set scrg = sws.Range("C45", sws.Cells(sws.Rows.Count, "C").End(xlUp))
    Dim srg As Range
    With sws.Range("C6", sws.Cells(6, sws.Columns.Count).End(xlToLeft))
        Set srg = .EntireColumn.Rows("6:40")
    End With
    Dim drOffset As Long: drOffset = srg.Rows.Count + 1
    
    Application.ScreenUpdating = False
    ' Prevent the formulas from the copied source ranges being calculated.
    Application.Calculation = xlCalculationManual
    
    ' Loop through the cells of the source column range.
    Dim scCell As Range
    For Each scCell In scrg.Cells
        dCell.Offset(1, 3).Value = scCell.Value ' this value is what the...
        srg.Copy dCell.Offset(2) ' ... formula-infested source range depends on
        Set dCell = dCell.Offset(drOffset) ' reference the next last cell
    Next scCell
    
    ' It may take a while after turning on calculation.
    Application.Calculation = xlCalculationAutomatic
    
    ' Replace the formulas with values.
    Set drg = dws.Range(dCell, dws.Cells(6, dws.Columns.Count).End(xlToLeft))
    drg.Copy
    drg.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    
    ' A Final Touch
    dws.Range("A2").Select
    
    Application.ScreenUpdating = True

    MsgBox "Data generated.", vbInformation

End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
  • Thank you! It works after i made some minor changes. Can you explain the copy paste in the loop? – b1man Mar 15 '22 at 07:45
  • Basically, the first line writes whatever you were searching for to the 3rd column. The second line copies the range (35 rows) and the last line sets the new last cell in the first column. To test and better understand this, add a few `Debug.Print` lines e.g. `Debug.Print sCell.Address, srg.Address, dCell.Address`, and after `Set dCell...` add `Debug.Print dCell.Address` so you can compare to the previous. If you have just copied 36 rows, you don't have to do `...End(xlUp).Row`, just make an offset for 36 rows. – VBasic2008 Mar 15 '22 at 08:00
  • Thank you again! I will give the Debug.print a try. I understand the copy part, but i do not see a paste line in the same loop and that confuses me – b1man Mar 18 '22 at 08:14
  • The [Range.Copy method](https://learn.microsoft.com/en-us/office/vba/api/excel.range.copy) doesn't need the subsequent `PasteSpecial` line if you supply a parameter for the `Destination` argument: `Range("A1").Copy Range("A2")` (short for `Range("A1").Copy Destination:=Range("A2")`) vs `Range("A1").Copy: Range("A2").PasteSpecial`. – VBasic2008 Mar 18 '22 at 08:27