How may i optimize my code to speed up the process?

Question

Thanks to the help from some users of this site, my vba code is now working well. But the process is quite long to be achieved, approx. 5 min for a little excel file to import and it is proportional with the excel file size to import...

How may I optimize it to speed up my import process ? Every tips, idea or advice is welcome Below is my code:

Option Explicit

Public Namepatch3 As String

Sub Figures()


Dim Filt As String
Dim IndexFiltre As Integer, NomFichier As Variant, Titre As String
Dim o As Integer, p As Integer
Dim Msg As String
Dim ConsoPDC As Workbook
Dim Fichier As String, fichier1 As String, chaine As String
Dim feuille As Variant
Dim Reponse As Integer
Dim Config As Integer
Dim nomClasseur As Variant
Dim vclasseur As Workbook
Dim resum As Workbook
Dim wkb As Workbook
Dim ws As Worksheet

Dim n
    With Worksheets("Dest")
        n = .Range("L" & .Rows.Count).End(xlUp).Row + 1
    End With

Set wkb = ActiveWorkbook

Namepatch3 = ThisWorkbook.Name

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'   File filters list
Filt = "txt files (*.txt),*.txt," & _
        "Lotus files (*.prn),*.prn," & _
        "Comma separated files (*.csv),*.csv," & _
        "ASCII files (*.asc),*.asc," & _
        "All files (*.*),*.*"
'   display *.* by default
IndexFiltre = 5
'   DialogBox
Titre = "Sélectionner les fichiers à traiter"
'   Get file name
NomFichier = Application.GetOpenFilename _
    (fileFilter:=Filt, _
     FilterIndex:=IndexFiltre, _
     Title:=Titre, _
     MultiSelect:=True)
'   Quit if the dialogbox is cancelled
If Not IsArray(NomFichier) Then
    MsgBox "No files were selected!"
    Application.StatusBar = False
    GoTo TheEnd
End If
'   display the entire path + file name
Config = vbYesNo + vbInformation + vbDefaultButton2
For o = LBound(NomFichier) To UBound(NomFichier)
    Msg = Msg & NomFichier(o)
Next o
Reponse = MsgBox("Please find below your file :" & vbCrLf & Msg & vbCrLf, Config, "MAJ resum")
If Reponse = vbNo Then
  GoTo TheEnd
End If


  '   MsgBox (Msg) ' Source file
   ' Test to check if the file has already been opened

   ' If yes => close file or use the opened file ? 
    Workbooks.Open Filename:=Msg


'------------------------------------------------------------------------------------------------------
Only select file name instead of whole path
fichier1 = Right(Msg, Len(Msg) - InStrRev(Msg, "\", -1, 1))
Fichier = Left(fichier1, InStr(fichier1, ".xls") - 1)

'Import process
'------------------------------------------------------------------------------------------------------

Dim i As Integer
Dim j As Integer
Dim K As Integer
Dim l  As Integer

Dim debutcols As Integer ' Year in number ?
Dim fincols As Integer ' Year in number ?
Dim debutas As Integer ' Column N° first year
Dim finas As Integer ' Column N° last year
Dim debutcold As Integer
Dim fincold As Integer
Dim debutad As Integer
Dim finad As Integer
Dim rowmaxwallets As Integer
Dim rowmaxwalletd As Integer
Dim c As Object
Dim therow As Integer
Dim Nlp As String
Dim Vcol(30) As Variant ' data paste year
Dim cpt As Integer


Windows(fichier1).Activate
Worksheets("DataBase").Select

debutcols = CInt(Worksheets("DataBase").Cells(1, 22))  ' (col V)  XXXX
debutas = 22
fincols = 0
fincold = 0
finas = 0
debutad = 0
finad = 0

' End column in source file
i = 0
For i = 1 To 30
   If Len(Worksheets("DataBase").Cells(1, i + 22)) = 4 Then
     ' If a year is found
     Else
     ' Plus 1 column
     i = i - 1
     finas = (22 + i)
     fincols = CInt(Worksheets("DataBase").Cells(1, i + 22))
     GoTo sortie
   End If
Next

sortie:
   Columns(ConvertCol(debutas) & ":" & ConvertCol(finas)).Select

   Windows(Namepatch3).Activate
   Worksheets("Dest").Select
   i = 0

   For i = 1 To 70
   If Worksheets("Dest").Cells(1, i) = debutcols Then
     debutcold = i
     debutad = i

     GoTo sortie2
     End If
   Next i

sortie2:
     finad = debutad + (finas - debutas)

   Windows(fichier1).Activate
   Sheets("DataBase").Select
   rowmaxwallets = CInt(Worksheets("DataBase").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)

   Windows(Namepatch3).Activate
   Worksheets("LP").Select

   rowmaxwalletd = CInt(Worksheets("LP").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)
   i = 0
   cpt = 1

   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationManual

   For i = 1 To rowmaxwalletd ' loop on all lines in source file


     Windows(Namepatch3).Activate
     Sheets("LP").Select


         'Read source file
     For l = 1 To rowmaxwallets
        ' dynamically copy figures
        Windows(fichier1).Activate
        Sheets("DataBase").Select
                   For j = 0 To (finas - debutas)
             Vcol(j) = Worksheets("Database").Cells(1822 + l, debutas + j)
           Next j
                     Windows(Namepatch3).Activate
           Worksheets("Dest").Select

          ' Paste figures
           For j = 0 To (finas - debutas)
             Worksheets("Dest").Cells(n, debutad + j) = Vcol(j)
           Next j
           n = n + 1


     Next l
   Next i
fin:
   Application.StatusBar = False
   Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   Worksheets("Dest").Select
   Range("A3").Select
   MsgBox ("Import done")

   'Set resource free

    Set wkb = Nothing

    Windows(fichier1).Activate
        ActiveWorkbook.Close

TheEnd:

End Sub

You should consider posting on [Code Review](https://codereview.stackexchange.com/), not here — appa yip yip, Jan 17 '18 at 12:41
You could avoid the use of [Select and Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) and read this reference: [Excel VBA : Efficiency and Performance](http://www.avdf.com/apr98/art_ot003.html). And use some timers to discover what part of your code is most time consuming and edit your post with the new information, describing what you want to do. If you are going to post on CodeReview, you should read: [A guide to Code Review for Stack Overflow users](https://codereview.meta.stackexchange.com/q/5777) — danieltakeshi, Jan 17 '18 at 12:41
Thanks for the guides guys. I've learned a lot by reading them :) — John Doe, Jan 24 '18 at 08:31

score 0 · Accepted Answer · answered Jan 17 '18 at 13:43

By removing the Select and Activate methods, it should speed up your code, I believe the following should do it:

Option Explicit

Public Namepatch3 As String

Sub Figures()

Dim Filt As String
Dim IndexFiltre As Integer, NomFichier As Variant, Titre As String
Dim o As Integer, p As Integer
Dim Msg As String
Dim ConsoPDC As Workbook
Dim Fichier As String, fichier1 As String, chaine As String
Dim feuille As Variant
Dim Reponse As Integer
Dim Config As Integer
Dim nomClasseur As Variant
Dim vclasseur As Workbook
Dim resum As Workbook
Dim ws As Worksheet

Dim n As Long
    With ThisWorkbook.Worksheets("Dest")
        n = .Range("L" & .Rows.Count).End(xlUp).Row + 1
    End With


Namepatch3 = ThisWorkbook.Name

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'   File filters list
Filt = "txt files (*.txt),*.txt," & _
        "Lotus files (*.prn),*.prn," & _
        "Comma separated files (*.csv),*.csv," & _
        "ASCII files (*.asc),*.asc," & _
        "All files (*.*),*.*"
'   display *.* by default
IndexFiltre = 5
'   DialogBox
Titre = "Sélectionner les fichiers à traiter"
'   Get file name
NomFichier = Application.GetOpenFilename _
    (fileFilter:=Filt, _
     FilterIndex:=IndexFiltre, _
     Title:=Titre, _
     MultiSelect:=True)
'   Quit if the dialogbox is cancelled
If Not IsArray(NomFichier) Then
    MsgBox "No files were selected!"
    Application.StatusBar = False
    GoTo TheEnd
End If
'   display the entire path + file name
Config = vbYesNo + vbInformation + vbDefaultButton2
For o = LBound(NomFichier) To UBound(NomFichier)
    Msg = Msg & NomFichier(o)
Next o
Reponse = MsgBox("Please find below your file :" & vbCrLf & Msg & vbCrLf, Config, "MAJ resum")
If Reponse = vbNo Then
  GoTo TheEnd
End If


  '   MsgBox (Msg) ' Source file
   ' Test to check if the file has already been opened

   ' If yes => close file or use the opened file ?
    Workbooks.Open Filename:=Msg


'------------------------------------------------------------------------------------------------------
'Only select file name instead of whole path
fichier1 = Right(Msg, Len(Msg) - InStrRev(Msg, "\", -1, 1))
Fichier = Left(fichier1, InStr(fichier1, ".xls") - 1)

'Import process
'------------------------------------------------------------------------------------------------------

Dim i As Integer
Dim j As Integer
Dim K As Integer
Dim l  As Integer

Dim debutcols As Integer ' Year in number ?
Dim fincols As Integer ' Year in number ?
Dim debutas As Integer ' Column N° first year
Dim finas As Integer ' Column N° last year
Dim debutcold As Integer
Dim fincold As Integer
Dim debutad As Integer
Dim finad As Integer
Dim rowmaxwallets As Integer
Dim rowmaxwalletd As Integer
Dim c As Object
Dim therow As Integer
Dim Nlp As String
Dim Vcol(30) As Variant ' data paste year
Dim cpt As Integer

debutcols = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(1, 22))  ' (col V)  XXXX
debutas = 22
fincols = 0
fincold = 0
finas = 0
debutad = 0
finad = 0

' End column in source file
i = 0
For i = 1 To 30
    If Len(Workbook(fichier1).Worksheets("DataBase").Cells(1, i + 22)) = 4 Then
        ' If a year is found
    Else
        ' Plus 1 column
        i = i - 1
        finas = (22 + i)
        fincols = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(1, i + 22))
        GoTo sortie
    End If
Next i

sortie:
   Columns(ConvertCol(debutas) & ":" & ConvertCol(finas)).Select

    For i = 1 To 70
        If Workbook(Namepatch3).Worksheets("Dest").Cells(1, i) = debutcols Then
            debutcold = i
            debutad = i
            GoTo sortie2
        End If
    Next i

sortie2:
    finad = debutad + (finas - debutas)

    rowmaxwallets = CInt(Workbook(fichier1).Worksheets("DataBase").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)

    rowmaxwalletd = CInt(Workbook(Namepatch3).Worksheets("LP").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)
    i = 0
    cpt = 1

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationManual

For i = 1 To rowmaxwalletd ' loop on all lines in source file
'Read source file
    For l = 1 To rowmaxwallets
        ' dynamically copy figures
        For j = 0 To (finas - debutas)
          Vcol(j) = Workbook(fichier1).Worksheets("Database").Cells(1822 + l, debutas + j)
        Next j

        ' Paste figures
        For j = 0 To (finas - debutas)
          Workbook(Namepatch3).Worksheets("Dest").Cells(n, debutad + j) = Vcol(j)
        Next j
    n = n + 1
    Next l
Next i
fin:
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Worksheets("Dest").Select
    Range("A3").Select
    MsgBox ("Import done")

   'Set resource free
    Workbook(fichier1).Close
TheEnd:

End Sub

Works like a charm ! Thanks a lot sir ! :) – John Doe Jan 22 '18 at 08:45 — John Doe, Jan 22 '18 at 08:45

How may i optimize my code to speed up the process?

1 Answers1