Vba Runs slow

R

Rampestamper

New Member
Joined
Apr 8, 2020
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hello all, I have created a vba instruction that automaticly copy paste a number of tables from diffrent tabs in to 3 tables. This is all working fine but is running very slow (1,5 minute )
Can somebody tell me how i can speed it up or that this speed is normal. (all tables are build on excel formulas so that is taking some time as well)

VBA Code: 
'Sheet names
    Const SheetInput = "Lijn_Genereren"
    Const SheetVarLCFP = "FB_LCFP Result"
    Const SheetVarLCF = "FB_LCF_Result"
    Const SheetVarPLL = "FB_PLL_Result"
    Const SheetVarPPC = "FB_PPC_Result"
    Const SheetVarPPU = "FB_PPU_Result"
    Const SheetGlobals = "Lijn_Genereren"
    
    'Input sheet constants
    Const InputStartRow = 11
    Const InputName = "B"
    Const InputFbType = "C"
    Const InputLoc = "B"
    
    'General constants
    Const MaxRow = "10000"
    Const EmptyEndRow = 1000000
    

Sub GenerateLine()
    Const StartRowGlob = 8
    Const VarsColGlobStart = "G"     'Var names colomn
    Const VarsColGlobEnd = "M"
    Const VarsColIntStart = "Q"
    Const VarsColIntEnd = "R"
    Const VarsColProgStart = "V"
    Const VarsColProgEnd = "V"
    Const StartGlob = "G8"
    
    Const LocLCFP = "'FB_LCFP Result'!B4"
    Const StartRowLCFP = 4
    Const StartRowGlobalLCFP = 52
    Const StartRowProgLCFP = 3
    Const ProgLCFPStart = "S"
    Const ProgLCFPEnd = "S"
    Const VarsLCFPIntStart = "G"
    Const VarsLCFPIntEnd = "M"
    Const VarsLCFPGlobalEnd = "H"
    Const LengthLCFP = 30
    Const LengthGlobalLCFP = 100
    
    Const LocLCF = "FB_LCF_Result!B4"
    Const StartRowLCF = 4
    Const StartRowGlobalLCF = 52
    Const StartRowProgLCF = 3
    Const ProgLCFStart = "S"
    Const ProgLCFEnd = "S"
    Const VarsLCFIntStart = "G"
    Const VarsLCFIntEnd = "M"
    Const VarsLCFGlobalEnd = "H"
    Const LengthLCF = 26
    Const LengthGlobalLCF = 100
    
    Const LocPLL = "FB_PLL_Result!B4"
    Const StartRowPLL = 4
    Const StartRowGlobalPLL = 37
    Const StartRowProgPLL = 3
    Const ProgPLLStart = "S"
    Const ProgPLLEnd = "S"
    Const VarsPLLIntStart = "G"
    Const VarsPLLIntEnd = "M"
    Const VarsPLLGlobalEnd = "H"
    Const LengthPLL = 18
    Const LengthGlobalPLL = 100
    
    Const LocPPC = "FB_PPC_Result!B4"
    Const StartRowPPC = 4
    Const StartRowGlobalPPC = 37
    Const StartRowProgPPC = 3
    Const ProgPPCStart = "S"
    Const ProgPPCEnd = "S"
    Const VarsPPCIntStart = "G"
    Const VarsPPCIntEnd = "M"
    Const VarsPPCGlobalEnd = "H"
    Const LengthPPC = 18
    Const LengthGlobalPPC = 100
    
    Const LocPPU = "FB_PPU_Result!B4"
    Const StartRowPPU = 4
    Const StartRowGlobalPPU = 37
    Const StartRowProgPPU = 3
    Const ProgPPUStart = "S"
    Const ProgPPUEnd = "S"
    Const VarsPPUIntStart = "G"
    Const VarsPPUIntEnd = "M"
    Const VarsPPUGlobalEnd = "H"
    Const LengthPPU = 16
    Const LengthGlobalPPU = 100
    
    
    Dim Location As String

    With Application                    'disable update (higher performance)
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
      .StatusBar = StatusBarMsg
      .EnableCancelKey = xlErrorHandler
    End With
    
    ThisWorkbook.Sheets(SheetGlobals).Select
    'Clear cells
    'Range(VarsColGlobStart & StartRowGlob, VarsColGlobEnd & MaxRow).Select

    'Format to Text because of FALSE vs ONWAAR (compatible between different language settings)
    Rows("2:" & EmptyEndRow).Select
    Selection.NumberFormat = "@" 'set cell format to text
        
    MaxNrModules = ThisWorkbook.Worksheets("Lijn_Genereren").Range("D9")
        
    'Empty cells (start with empty cells)
    Range(VarsColGlobStart & StartRowGlob, VarsColGlobEnd & MaxRow).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp    'Delete range (Shift cells up)

    PasteRow = StartRowGlob
    PasteRowGlob = StartRowGlob
    PasteRowProgram = StartRowGlob
    
    'Start For/Next Loop
    For n = InputStartRow To MaxNrModules
    
    ModuleType = ThisWorkbook.Sheets(SheetInput).Range(InputFbType & n)
    
    Select Case ModuleType
    
    Case "FB_Mod_LCFP"
    'Collect LCFP Data
       'Internal variables copy/paste
            Location = ThisWorkbook.Sheets(SheetInput).Range(InputLoc & n)
             
             'Kopieer Interne variablen
            ThisWorkbook.Sheets(SheetVarLCFP).Select                                                                    'Selecteer LCFP pagina
            Range(LocLCFP).Value = Location                                                                             'Vul locatie Nr in
            LengthInternalLCFP = ThisWorkbook.Worksheets("FB_LCFP Result").Range("B22")                                 'Bereken de te kopieren lengte van lijst
            EndRow = StartRowLCFP + LengthInternalLCFP - 1
            Range(VarsLCFPIntStart & StartRowLCFP, VarsLCFPIntEnd & EndRow).Copy                                        'Kopieer de interne variabelen
            
            'Plak interne variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColGlobStart & PasteRow).Select                                                                   'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
            
            'Kopieer externe variablen
            ThisWorkbook.Sheets(SheetVarLCFP).Select                                                                    'Selecteer LCFP pagina
            LenghtExternalLCFP = ThisWorkbook.Worksheets("FB_LCFP Result").Range("B23")                                 'Bereken de te kopieren lengte van de lijst
            EndRow = StartRowGlobalLCFP + LenghtExternalLCFP - 1
            Range(VarsLCFPIntStart & StartRowGlobalLCFP, VarsLCFPGlobalEnd & EndRow).Copy                               'Kopieer de externe variabelen

            'Plak externe variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColIntStart & PasteRowGlob).Select                                                                'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
               
            'Kopieer programma
            ThisWorkbook.Sheets(SheetVarLCFP).Select                                                                    'Selecteer LCFP pagina
            LenghtProgramLCFP = ThisWorkbook.Worksheets("FB_LCFP Result").Range("B24")                                  'Bereken de te kopieren lengte van lijst
            EndRow = StartRowProgLCFP + LenghtProgramLCFP - 1
            Range(ProgLCFPStart & StartRowProgLCFP, ProgLCFPEnd & EndRow).Copy                                          'Kopieer het programma
            
            'Plak programma in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColProgStart & PasteRowProgram).Select                                                            'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
                
            PasteRowGlob = PasteRowGlob + LenghtExternalLCFP                                                            'Sla locatie laatste regel geplakte externe variabelen op
            PasteRow = PasteRow + LengthInternalLCFP                                                                    'Sla locatie laatste regel geplakte interne variabelen op
            PasteRowProgram = PasteRowProgram + LenghtProgramLCFP                                                       'Sla locatie laatste regel geplakte programma op

    Case "FB_Mod_LCF"
    'Collect LCF Data
       'Internal variables copy/paste
            Location = ThisWorkbook.Sheets(SheetInput).Range(InputLoc & n)
             
             'Kopieer Interne variablen
            ThisWorkbook.Sheets(SheetVarLCF).Select                                                                     'Selecteer LCF pagina
            Range(LocLCF).Value = Location                                                                              'Vul locatie Nr in
            LengthInternalLCF = ThisWorkbook.Worksheets("FB_LCF_Result").Range("B22")                                   'Bereken de te kopieren lengte van lijst
            EndRow = StartRowLCF + LengthInternalLCF - 1
            Range(VarsLCFIntStart & StartRowLCF, VarsLCFIntEnd & EndRow).Copy                                           'Kopieer de interne variabelen
            
            'Plak interne variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColGlobStart & PasteRow).Select                                                                   'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
            
            'Kopieer externe variablen
            ThisWorkbook.Sheets(SheetVarLCF).Select                                                                     'Selecteer LCF pagina
            LenghtExternalLCF = ThisWorkbook.Worksheets("FB_LCF_Result").Range("B23")                                   'Bereken de te kopieren lengte van de lijst
            EndRow = StartRowGlobalLCF + LenghtExternalLCF - 1
            Range(VarsLCFIntStart & StartRowGlobalLCF, VarsLCFGlobalEnd & EndRow).Copy                                  'Kopieer de externe variabelen

            'Plak externe variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColIntStart & PasteRowGlob).Select                                                                'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
               
            'Kopieer programma
            ThisWorkbook.Sheets(SheetVarLCF).Select                                                                     'Selecteer LCF pagina
            LenghtProgramLCF = ThisWorkbook.Worksheets("FB_LCF_Result").Range("B24")                                    'Bereken de te kopieren lengte van lijst
            EndRow = StartRowProgLCF + LenghtProgramLCF - 1
            Range(ProgLCFStart & StartRowProgLCF, ProgLCFEnd & EndRow).Copy                                             'Kopieer het programma
            
            'Plak programma in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColProgStart & PasteRowProgram).Select                                                            'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
                
            PasteRowGlob = PasteRowGlob + LenghtExternalLCF                                                             'Sla locatie laatste regel geplakte externe variabelen op
            PasteRow = PasteRow + LengthInternalLCF                                                                     'Sla locatie laatste regel geplakte interne variabelen op
            PasteRowProgram = PasteRowProgram + LenghtProgramLCF                                                        'Sla locatie laatste regel geplakte programma op

    Case "FB_Mod_PLL"
    'Collect PLL Data
       'Internal variables copy/paste
            Location = ThisWorkbook.Sheets(SheetInput).Range(InputLoc & n)
             
             'Kopieer Interne variablen
            ThisWorkbook.Sheets(SheetVarPLL).Select                                                                     'Selecteer PLL pagina
            Range(LocPLL).Value = Location                                                                              'Vul locatie Nr in
            LengthInternalPLL = ThisWorkbook.Worksheets("FB_PLL_Result").Range("B22")                                   'Bereken de te kopieren lengte van lijst
            EndRow = StartRowPLL + LengthInternalPLL - 1
            Range(VarsPLLIntStart & StartRowPLL, VarsPLLIntEnd & EndRow).Copy                                           'Kopieer de interne variabelen
            
            'Plak interne variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColGlobStart & PasteRow).Select                                                                   'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
            
            'Kopieer externe variablen
            ThisWorkbook.Sheets(SheetVarPLL).Select                                                                     'Selecteer PLL pagina
            LenghtExternalPLL = ThisWorkbook.Worksheets("FB_PLL_Result").Range("B23")                                   'Bereken de te kopieren lengte van de lijst
            EndRow = StartRowGlobalPLL + LenghtExternalPLL - 1
            Range(VarsPLLIntStart & StartRowGlobalPLL, VarsPLLGlobalEnd & EndRow).Copy                                  'Kopieer de externe variabelen

            'Plak externe variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColIntStart & PasteRowGlob).Select                                                                'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
               
            'Kopieer programma
            ThisWorkbook.Sheets(SheetVarPLL).Select                                                                     'Selecteer PLL pagina
            LenghtProgramPLL = ThisWorkbook.Worksheets("FB_PLL_Result").Range("B24")                                    'Bereken de te kopieren lengte van lijst
            EndRow = StartRowProgPLL + LenghtProgramPLL - 1
            Range(ProgPLLStart & StartRowProgPLL, ProgPLLEnd & EndRow).Copy                                             'Kopieer het programma
            
            'Plak programma in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColProgStart & PasteRowProgram).Select                                                            'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
                
            PasteRowGlob = PasteRowGlob + LenghtExternalPLL                                                             'Sla locatie laatste regel geplakte externe variabelen op
            PasteRow = PasteRow + LengthInternalPLL                                                                     'Sla locatie laatste regel geplakte interne variabelen op
            PasteRowProgram = PasteRowProgram + LenghtProgramPLL                                                        'Sla locatie laatste regel geplakte programma op

    Case "FB_Mod_PPC"
    'Collect PPC Data
       'Internal variables copy/paste
            Location = ThisWorkbook.Sheets(SheetInput).Range(InputLoc & n)
             
             'Kopieer Interne variablen
            ThisWorkbook.Sheets(SheetVarPPC).Select                                                                     'Selecteer PPC pagina
            Range(LocPPC).Value = Location                                                                              'Vul locatie Nr in
            LengthInternalPPC = ThisWorkbook.Worksheets("FB_PPC_Result").Range("B22")                                   'Bereken de te kopieren lengte van lijst
            EndRow = StartRowPPC + LengthInternalPPC - 1
            Range(VarsPPCIntStart & StartRowPPC, VarsPPCIntEnd & EndRow).Copy                                           'Kopieer de interne variabelen
            
            'Plak interne variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColGlobStart & PasteRow).Select                                                                   'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
            
            'Kopieer externe variablen
            ThisWorkbook.Sheets(SheetVarPPC).Select                                                                     'Selecteer PPC pagina
            LenghtExternalPPC = ThisWorkbook.Worksheets("FB_PPC_Result").Range("B23")                                   'Bereken de te kopieren lengte van de lijst
            EndRow = StartRowGlobalPPC + LenghtExternalPPC - 1
            Range(VarsPPCIntStart & StartRowGlobalPPC, VarsPPCGlobalEnd & EndRow).Copy                                  'Kopieer de externe variabelen

            'Plak externe variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColIntStart & PasteRowGlob).Select                                                                'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
               
            'Kopieer programma
            ThisWorkbook.Sheets(SheetVarPPC).Select                                                                     'Selecteer PPC pagina
            LenghtProgramPPC = ThisWorkbook.Worksheets("FB_PPC_Result").Range("B24")                                    'Bereken de te kopieren lengte van lijst
            EndRow = StartRowProgPPC + LenghtProgramPPC - 1
            Range(ProgPPCStart & StartRowProgPPC, ProgPPCEnd & EndRow).Copy                                             'Kopieer het programma
            
            'Plak programma in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColProgStart & PasteRowProgram).Select                                                            'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
                
            PasteRowGlob = PasteRowGlob + LenghtExternalPPC                                                             'Sla locatie laatste regel geplakte externe variabelen op
            PasteRow = PasteRow + LengthInternalPPC                                                                     'Sla locatie laatste regel geplakte interne variabelen op
            PasteRowProgram = PasteRowProgram + LenghtProgramPPC                                                        'Sla locatie laatste regel geplakte programma op
        
    Case "FB_Mod_PPU"
    'Collect PPU Data
       'Internal variables copy/paste
            Location = ThisWorkbook.Sheets(SheetInput).Range(InputLoc & n)
             
             'Kopieer Interne variablen
            ThisWorkbook.Sheets(SheetVarPPU).Select                                                                     'Selecteer PPU pagina
            Range(LocPPU).Value = Location                                                                              'Vul locatie Nr in
            LengthInternalPPU = ThisWorkbook.Worksheets("FB_PPU_Result").Range("B22")                                   'Bereken de te kopieren lengte van lijst
            EndRow = StartRowPPU + LengthInternalPPU - 1
            Range(VarsPPUIntStart & StartRowPPU, VarsPPUIntEnd & EndRow).Copy                                           'Kopieer de interne variabelen
            
            'Plak interne variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColGlobStart & PasteRow).Select                                                                   'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
            
            'Kopieer externe variablen
            ThisWorkbook.Sheets(SheetVarPPU).Select                                                                     'Selecteer PPU pagina
            LenghtExternalPPU = ThisWorkbook.Worksheets("FB_PPU_Result").Range("B23")                                   'Bereken de te kopieren lengte van de lijst
            EndRow = StartRowGlobalPPU + LenghtExternalPPU - 1
            Range(VarsPPUIntStart & StartRowGlobalPPU, VarsPPUGlobalEnd & EndRow).Copy                                  'Kopieer de externe variabelen

            'Plak externe variabelen in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColIntStart & PasteRowGlob).Select                                                                'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
               
            'Kopieer programma
            ThisWorkbook.Sheets(SheetVarPPU).Select                                                                     'Selecteer PPU pagina
            LenghtProgramPPU = ThisWorkbook.Worksheets("FB_PPU_Result").Range("B24")                                    'Bereken de te kopieren lengte van lijst
            EndRow = StartRowProgPPU + LenghtProgramPPU - 1
            Range(ProgPPUStart & StartRowProgPPU, ProgPPUEnd & EndRow).Copy                                             'Kopieer het programma
            
            'Plak programma in lijst
            ThisWorkbook.Sheets(SheetGlobals).Select                                                                    'Selecteer Lijn_Genereren Pagina
            Range(VarsColProgStart & PasteRowProgram).Select                                                            'Selecteer eerste vrije plek in lijst
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False         'Plak de gekopieerde tekst
            ActiveWindow.SmallScroll Down:=11
            
            '-----------------------------------------------------
                
            PasteRowGlob = PasteRowGlob + LenghtExternalPPU                                                             'Sla locatie laatste regel geplakte externe variabelen op
            PasteRow = PasteRow + LengthInternalPPU                                                                     'Sla locatie laatste regel geplakte interne variabelen op
            PasteRowProgram = PasteRowProgram + LenghtProgramPPU                                                        'Sla locatie laatste regel geplakte programma op
        
   End Select
        
    Next n
    
    PasteRow = PasteRow - 1

    Range(VarsColGlobStart & StartRowGlob, VarsColGlobEnd & PasteRow).Select   'color cells green, to indicate they have to be copied
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With

    ThisWorkbook.Sheets(SheetGlobals).Select                                        'go to start position
    Range(VarsColGlobStart & StartRowGlob).Select                                   'go to start position
    Application.Goto Range("A1"), Scroll:=True
    Range(StartGlob, VarsColGlobEnd & PasteRow).Select        'go to start position

    ThisWorkbook.Sheets(SheetInput).Select                                        'go to start position
    Application.Goto Range("A6"), Scroll:=True

    ThisWorkbook.Sheets(SheetGlobals).Select                                        'go to start position
    
    With Range("Lijn_Genereren!G8:M5000")
        .Value = .Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End With


    
    With Range("Lijn_Genereren!q8:r10000")
        .Value = .Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End With
    
    
    

    
    With Application                                                    'enable update again
          .ScreenUpdating = True
          .EnableEvents = True
          .DisplayAlerts = True
          .StatusBar = False
          .EnableCancelKey = xlInterrupt
    End With

End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
I see that you are already turning off screen updating. You could also turn off worksheet calculation

VBA Code: 
With Application                                  'disable update (higher performance)
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .StatusBar = StatusBarMsg
        .EnableCancelKey = xlErrorHandler
        .Calculation = xlCalculationManual
    End With
    '
    'your code
    '
   With Application                                  'enable update again
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .StatusBar = False
        .EnableCancelKey = xlInterrupt
        .Calculation = xlCalculationAutomatic
    End With


Your code is full of selects, and using a lot of selects slows things down. Most of the time, you can write code in such a way that select is not needed.
An example:
Before
VBA Code: 
    'Kopieer programma
    ThisWorkbook.Sheets(SheetVarLCFP).Select          'Selecteer LCFP pagina
    LenghtProgramLCFP = ThisWorkbook.Worksheets("FB_LCFP Result").Range("B24")    'Bereken de te kopieren lengte van lijst
    EndRow = StartRowProgLCFP + LenghtProgramLCFP - 1
    Range(ProgLCFPStart & StartRowProgLCFP, ProgLCFPEnd & EndRow).Copy    'Kopieer het programma

    'Plak programma in lijst
    ThisWorkbook.Sheets(SheetGlobals).Select          'Selecteer Lijn_Genereren Pagina
    Range(VarsColProgStart & PasteRowProgram).Select  'Selecteer eerste vrije plek in lijst
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False    'Plak de gekopieerde tekst

After
VBA Code: 
    'Kopieer programma
    LenghtProgramLCFP = ThisWorkbook.Worksheets("FB_LCFP Result").Range("B24").Value    'Bereken de te kopieren lengte van lijst
    EndRow = StartRowProgLCFP + LenghtProgramLCFP - 1
    ThisWorkbook.Sheets(SheetVarLCFP).Range(ProgLCFPStart & StartRowProgLCFP, ProgLCFPEnd & EndRow).Copy    'Kopieer het programma

    'Plak programma in lijst
    With ThisWorkbook.Sheets(SheetGlobals).Range(VarsColProgStart & PasteRowProgram)
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False    'Plak de gekopieerde tekst
    End With
 
Upvote 0
Thank you! i cannot turn off worksheet calculation because when the vba code is running the sheets are calculating everything for the new value it gets. But by removing (alot) selects the speed of my worksheet is nog 35 seconds (what is not unlogic because of alle the formulas it needs to calculate). The only thing maybe that could get improved is the delete duplicates instruction:

VBA Code: 
    With Range("Lijn_Genereren!q8:r10000")
        .Value = .Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        On Error GoTo 0
    End With

This code looks now until row 10.000 but most of the time the last row is for example 2000. How can i make it that the instruction is gonna use "PasteRow" (i already know the last written cell with that one) so that its gonna use Range("Lijn_Genereren!q8:r PasteRow ")?
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top