[SOLVED] VBA code takes too long og Excel stops responding


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
Sheets("Flight FS").Range(ActiveCell, Sheets("Flight FS").Range("C6").End(xlToRight)).Select

Dim rng As Range, cell As Range

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

For Each cell In rng
Sheets("Flight FS templ").Select
Sheets("Flight FS templ").Range("c6", Sheets("Flight FS 
Sheets("Flight FS").Select
ActiveCell.Offset(rowoffset:=2, columnoffset:=0).Activate
ActiveCell.Offset(rowoffset:=1, columnoffset:=3).Activate
ActiveCell.Value = cell
Next cell

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


Application.CutCopyMode = False

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub


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))
    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.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    ' A Final Touch
    Application.ScreenUpdating = True

    MsgBox "Data generated.", vbInformation

End Sub

Answered By – VBasic2008

Answer Checked By – David Marino (BugsFixing Volunteer)

Leave a Reply

Your email address will not be published. Required fields are marked *