Accelerate the process of filling the quality control table

Question

I'm working on a report of quality control. I've got a table, with all the points of control inside, and each time, when I get a new test result, Excel should fill this table. My code already works, but slowly (I have 15000 lines in this table, and it takes me 4 minutes to fill it), so I wish I can accelerate a little bit.

Here is my general idea:

The results of one test is composted by nearly 3000 .txt files, and I have a list L which contains the names of all these files that I should open and import the data into Excel. I open the list L, and open the .txt file one by one, to import the results into a sheet "Brouillon" all at once, then fill the table with its help. I think it could be faster.

'to chose the list L
Private Sub Button_Parcourir_Click()

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "import_excel.txt"
.Show
listPath = .SelectedItems(1)
End With
TextBox1.Text = listPath
End Sub

Private Sub Button_Importer_Click()

'create a sheet named "Brouillon":
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Brouillon"
Range("A1").Select

'open the list L and import the data into "Brouillon":
list_de_Controle = "TEXT;" & listPath
Open listPath For Input As #1
Do While Not EOF(1)
    Line Input #1, nom_de_Fich
    mfile = Dir(nom_de_Fich & "*.*")

    If mfile <> "" Then
        Open nom_de_Fich For Input As #2
        Fich_dansList = Fich_dansList & nom_de_Fich & "|"
        Inserer_contenu
        Close #2
    End If
Loop
Close #1

'count how many lines and columns we have in "Data":
Worksheets(Array(1)).Select
Range("A3").Select
ActiveCell.End(xlDown).Select
ActiveCell.End(xlToRight).Select
ligne_Data = Selection.Row
ma_Colonne = Selection.Column + 1

'count how many lines and columns we have in "Brouillon":
Count_Brouillon
'put a flag to reduce the loop
marque_ligneBrouillon = 1

'for each line in "Data":
For i = 4071 To ligne_Data
    'find which file I should open (mon_objet):
    mon_objet = Sheets("Data").Cells(i, 15).Text        
    'begin to search in "Brouillon" (from the last time where it stopped):
    For j = marque_ligneBrouillon To ligne_Brouillon
        'check the file:
        If InStr(Sheets("Brouillon").Cells(j, 1).Text, mon_objet) <> 0 Then
            'put this file in list:
            opened_Fich = opened_Fich & Sheets("Brouillon").Cells(j, 1).Text & "|"                
            'check the zone:
            If InStr(Sheets("Brouillon").Cells(j, 2).Text, Sheets("Data").Cells(i, 18).Text) <> 0 _
            Or InStr(Sheets("Data").Cells(i, 18).Text, "/") <> 0 Then

                'in the correct line in "Brouillon" from the beginning till the end:
                For k = 2 To colonne_Brouillon

                    'check the control whose result I'm looking for:
                    If InStr(Sheets("Brouillon").Cells(j, k).Text, Sheets("Data").Cells(i, 20).Text) <> 0 Then

                        'if this cell contains the result:
                        '1. put the mark here
                        marque_ligneBrouillon = j
                        '2. put the result inside:
                        mon_Data = Sheets("Brouillon").Cells(j, k).Text
                        Sheets("Data").Cells(i, ma_Colonne).Value = mon_Data
                        Flag_j = True
                        Exit For
                    End If

                Next k

            End If

        End If
        If Flag_j Then Exit For

    Next j
    Flag_j = False

Next i

Dim nb_Unique As Long
'because one txt.file could be opened a several times, so I want to remove the duplicate lines:
BList = Split(opened_Fich, "|")
With Worksheets("Brouillon")
    .Range("A1").Resize(UBound(BList)).Value = Application.Transpose(BList)
End With
Sheets("Brouillon").Columns(1).RemoveDuplicates Columns:=Array(1), Header:=xlNo
nb_Unique = Sheets("Brouillon").Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues).Count
Debug.Print nb_Unique

'then put list L after all these files:
AList = Split(Fich_dansList, "|")
With Worksheets("Brouillon")
    .Range("A1").End(xlDown).Offset(1).Resize(UBound(AList)).Value = Application.Transpose(AList)
End With
'then remove again all the duplicate parts:
Sheets("Brouillon").Columns(1).RemoveDuplicates Columns:=Array(1), Header:=xlNo
'so the ones that haven't been opened are listed after those have been opened:
nb_total = Sheets("Brouillon").Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues).Count 
End Sub

Then I'll do the nearly the same thing to put all these haven't been opened files at the end of the table. Because they are the new tests points that have been just added into the test, there is no correct 'place' for them, and I have to complete and improve the table.

Public Sub Inserer_Nom_Fich()
ActiveCell.Value = nom_de_Fich
ActiveCell.Offset(0, 1).Select
End Sub

Public Sub Inserer_contenu()

Dim keyWord As String

keyWord = "Zone"
Inserer_Nom_Fich
Do While Not EOF(2)
    Line Input #2, contenu
    'if it's a new zone:
    If InStr(contenu, keyWord) < 1 Then
        ActiveCell = contenu
    'if it's not:
    Else                               
        ActiveCell.Offset(1, 0).Select
        ActiveCell.End(xlToLeft).Select
        Inserer_Nom_Fich
        ActiveCell = contenu
    End If

    ActiveCell.Offset(0, 1).Select
Loop
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Select
End Sub

Public Sub Count_Brouillon()
ligne_Brouillon = Sheets("Brouillon").UsedRange.Rows.Count
colonne_Brouillon = Sheets("Brouillon").UsedRange.Columns.Count
End Sub

It's a little bit too long, so I've tried to add some comments to help you to read. If you've got some ideas to improve and accelerate the program, or something I've not good explained, please leave a comment.

Answer 1

A few notes on code-quality and what you can do to make this easier to read and maintain. I'm sure someone else will address the low-hanging performance fruit that I'll leave.

Methods are a thing

I find that your code has many sections extemely similar to the following:

'create a sheet named "Brouillon":
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Brouillon"
Range("A1").Select

They always follow the same "pattern"

'explanation what happens
DoTheThing
ButMakeItHappenOnTheLowestLevelOfAbstraction

These sections you have there are actually methods

You should seriously consider extracting them into subs:

Private Sub AppendSheet(Optional ByVal sheetName As String = "Brouillon")
    Sheets.Add After := Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = sheetName
    Range("A1").Select
End Sub

You can rinse and repeat the extraction of these methods to make your Button_Importer_Click() sub much easier to grasp as a whole. After doing all extractions into methods, the method could look like the following:

Private Sub Button_Importer_Click()
    AppendSheet("Brouillon")
    ImportControlSheetTo("Brouillon")
    Dim rows As Long
    rows = CountRows()
    Dim columns As Long
    columns = CountColumns(rows)

    ImportData(rows, columns)
    RemoveDuplicateRows("Brouillon")
    TransposeResults("Brouillon")
    RemoveDuplicateColumns("Brouillon")
    Dim total As Long
    total = CountSpecialCells("Brouillon")
End Sub

Now we can see what that Sub does on a single screen without scrolling. This is extremely important because it makes reasoning about the code significantly easier.

But now that we did that, there's another Problem that becomes apparent. You're using "Brouillon" in a lot of places. What if you mistyped it somewhere? What if you were asked to change the name?

Extract semantically useful constants

As I see it "Brouillon" (jeebus that's the 15th time or so I almost mistyped it) is a magic string. It carries no semantic meaning, because if you fail to type it correctly, the code stops working.
You should consider extracting it into a constant instead:

Private Const SHEET_NAME As String = "Brouillon"

Same goes for "Data" as well as 18, 15, 2 and all the other magic numbers you're using in your actual import code. I have no clue what those numbers stand for, so I'll leave it to you to find a name.

Further nitpicks & standard advice

• Use Option Explicit to avoid spending time on hunting typos.

• Avoid Working on the Workbook directly. It's slow as heck. Instead work with Arrays.

• Use Worksheets instead of Sheets. It's guaranteed to only contain Worksheets. Sheets may contain more than just that.

• Avoid implicit usage of Range and Worksheets. When the user interacts with Excel while your macro runs, they change, which is bad.

• Don't work with Select and Active*. In general those are slower than explicitly accessing Cells, Ranges and so on.

• Check whether you can invert if-conditions to reduce nesting. It's hard to read code that starts 20 columns in, because it makes horizontal scrolling a necessity. Scrolling in general is a bad thing, because it requires you to expend additional mental resources.

Answer 2

There can be only one...

'to chose the list L
Private Sub Button_Parcourir_Click()

Private Sub Button_Importer_Click()

Public Sub Inserer_contenu()

Public Sub Count_Brouillon()

VBA keywords are English. Event identifiers are English. Your comments are written in English. Well-abstracted code often reads like [something close to] plain English. Whether your UI is in English, French, Japanese, Valeryan or Dothraki, shouldn't affect how your code reads: a browse button browses folders regardless of how the UI puts it.

Avoid underscores in identifiers; as you probably noticed, an underscore in a procedure name means one thing: that the procedure is part of some other interface - in this case a button's events. There is great consistency in how that convention is applied throughout the language, and it's always IdentifierOrInterfaceName_[MemberName] - two distinct PascalCase parts, separated by an underscore. Notice everything in the VBA standard library follows this convention: public members are PascalCase, not Upper_Snake_Case.

Therefore, the Frenglish Button_Parcourir identifier should have been named BrowseButton, making its Click handler BrowseButton_Click.

Then, the BrowseButton's caption can be "browse", "parcourir", "blättern", or "スクロール", it doesn't matter; whoever is reading the code doesn't need to be bothered with UI concerns, and if they can read English, they can understand what that button with a cryptic caption is meant to be doing.

---

Abstr-action

Event handlers handle events - but that doesn't mean you have to implement all the logic right there and now. Picture these two scenarios:

• Logic is implemented in event handlers; having the nitty-gritty details of everything that happens in one place makes it easier to follow, because everything I need to know is inside that event handler.
• Event handlers contain very little code; merely a procedure call, well-named, that is found further down the code module, or even in another module. The code reads from high-level at the top to nitty-gritty details at the bottom. Having small, specialized procedures and functions named after the one thing they're doing makes the code easier to follow, because I can skip over the implementation details of things known to work, and step into the nitty-gritty details of things that need more attention.

One of these two statements is a lie, a common misconception in beginning programmers: the more a procedure does, the more reasons it has to fail. The more reasons it has to fail, the more bugs there will be. Code that's obviously correct doesn't even need to be looked at. At the end of the day, it boils down to a golden principle: the Single Responsibility Principle.

By abstracting responsibilities into small procedures that do one thing (and do it well!), you increase the quality of your code, and make it easier to read and to maintain.

That browse button makes an easy example: just by reading the code, how do you know what happens if the user cancels the prompt? What if there is no selection?

Let's turn this:

Private Sub Button_Parcourir_Click()

With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = "import_excel.txt"
.Show
listPath = .SelectedItems(1)
End With
TextBox1.Text = listPath
End Sub

Into this:

Option Explicit
Private filePath As String

Private Sub BrowseButton_Click()
    filePath = PromptForFilename("import_excel.txt")
    FilenameBox.Text = filePath
End Sub

Private Function PromptForFilename(ByVal defaultName As String) As String

    On Error GoTo CleanFail
    Dim result As String

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .InitialFileName = defaultName
        .Show
        result = .SelectedItems(1)
    End With

CleanExit:
    PromptForFilename = result
    Exit Function

CleanFail:
    result = vbNullString
    Resume CleanExit

End Function

Now, if the prompt gets cancelled, .Show will return 0 and .SelectedItems(1) will raise runtime error 9 "subscript out of range"; execution will jump to CleanFail and the function will return vbNullString.

A cleaner way of handling it could be to actually use the return value of .Show:

Private Function PromptForFilename(ByVal defaultName As String) As String

    On Error GoTo CleanFail
    Dim result As String

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .InitialFileName = defaultName
        If .Show Then 
            result = .SelectedItems(1)
        Else
            'prompt was cancelled by user
            result = vbNullString
        End If
    End With

CleanExit:
    PromptForFilename = result
    Exit Function

CleanFail:
    result = vbNullString
    Resume CleanExit

End Function

Now, if the prompt gets cancelled, .Show will return a 0 that will be implicitly converted into Boolean value False and result will be set to vbNullString and the function will return that - and if anything else we didn't see coming fails, we'll return an empty string as well.

---

I/O

So you have a file name (or an empty string), and then you want to import it.

'open the list L and import the data into "Brouillon":
list_de_Controle = "TEXT;" & listPath
Open listPath For Input As #1

Several things can go wrong with these two lines, and none of it is handled. What happens if...

• User clicks the "import" button while listPath is unassigned/empty?
• An I/O error occurrs while reading the file? Does the file get cleanly closed?
• User clicks the "import" button again after the first attempt failed?

Let's go back to the "browse" button handler, and address the first point:

Private Sub BrowseButton_Click()
    filePath = PromptForFilename("import_excel.txt")
    FilenameBox.Text = filePath
    ImportButton.Enabled = filePath <> vbNullString
End Sub

Now the user won't be able to click the "import" button until they browse for a valid, existing file without cancelling the prompt.

Now this is a big problem:

Open listPath For Input As #1
Do While Not EOF(1)
    Line Input #1, nom_de_Fich
    mfile = Dir(nom_de_Fich & "*.*")

    If mfile <> "" Then
        Open nom_de_Fich For Input As #2
        Fich_dansList = Fich_dansList & nom_de_Fich & "|"
        Inserer_contenu
        Close #2
    End If
Loop
Close #1

You're dealing with two files here, and the first one isn't closed until all lines have processed - this violates the golden rule of I/O: whenever you have a file opened, you should do everything you can to close that file as soon as possible. If you open a file and then start doing two hundred different things, you increase the number of things that can go wrong, and by Murphy's Law it will go wrong, one day or another.

Read the first file in one go, store the filenames into an array or a collection, and then close it immediately. Then process each filename individually.

If an error occurs anywhere in the process, your code leaves two files open.

Let VBA handle file numbering for you, never hard-code file numbers. Any procedure that is dealing with more than a single file number is doing too much work, has too many reasons to fail and should be broken down into smaller, more specialized procedures.

Private Function GetFileList(ByVal path As String) As Collection

    On Error GoTo CleanFail
    Dim result As Collection
    Set result = New Collection

    Dim fn As Integer
    fn = FreeFile

    Open path For Input As #fn

    Dim item As String
    While Not EOF(fn)
        Line Input #fn, item
        If IsValidFileName(item) Then result.Add item
    Wend

CleanExit:
    Close #fn
    Set GetFileList = result
    Exit Function

CleanFail:
    Set result = New Collection
    Resume CleanExit

End Function

FreeFile is a built-in function located in the VBA.FileSystem module, that returns an Integer representing the next available file number: any VBA code that reads or writes to files should use this function to get a file number.

Notice the above code closes the file under the CleanExit label, which runs regardless of whether or not a runtime error has occurred in the process.

Also notice that the procedure isn't responsible for validating the item filename itself: it reads a file line by line, and adds valid ones to its result collection.

VBA has many, many, [too] many different ways to loop. You went with Do While {condition}...Loop, but IMO the Do is redundant here, a While {condition}...Wend loop would be more straightforward - but yeah, it does exactly the same thing.

Now, the calling code can do this:

Dim files As Collection
Set files = GetFileList(filePath)

Dim file 'As Variant
For Each file In files
    ImportFile file
Next

And ImportFile would be a procedure taking a single String parameter and responsible for importing one, single file. Again, it should open the file, read its data into some temporary data structure, and close the file as soon as possible - then dump the data onto a worksheet. A file that's opened in one procedure, should be closed in that same procedure. Always. And regardless of whether or not a runtime error occurs.

---

Sheetwork

That's the slow part. Any speed you've gained from iterating the files and their contents only once (with the file handles open all the while) is being lost here. All of it.

The "low-hanging fruit" @Vogel612 mentioned, is something like this:

Public Sub ToggleWaitMode(Optional ByVal wait As Boolean = False, Optional ByVal status As String = vbNullString)
    With Application
        .Calculation = IIf(wait, xlCalculationManual, xlCalculationAutomatic)
        .StatusBar = status
        .EnableEvents = Not wait
        .ScreenUpdating = Not wait
    End With
End Sub

Then you can do this to disable screen updating, worksheet events and automatic calculations:

ToggleWaitMode True, "Please wait..."

And then this to restore it (be sure to run that regardless of whether or not a runtime error occurs):

ToggleWaitMode

That alone can greatly speed up your code. But it's only speed-up that's achieved by disabling several things Excel does every time anything changes in a worksheet (e.g. firing worksheet events, recalculating modified cells, redrawing its client area) - it doesn't make it any more efficient.

I'd love to help you make your loop more efficient, but I'm out of time, and this answer is already long enough - all I can say is:

• DO use meaningful names. Flag_j is not a meaningful name. What does it do? What toggles it? What is it used for?
• AVOID .Select and .Activate; this can never be told too often. Avoid .Select and .Activate like the plague. See this excellent SO Q&A for more info.
• CONSIDER working with arrays, and if at all possible making a single spreadsheet write operation. The fewer you manipulate a worksheet, the faster your code will be.