VBA Sort-Compile-Write data from multiple worksheet on changes

Question

I finished a code that sorts and compiles daily work data into a weekly summary. Its triggered by workbook changes so it refreshes automatically.

Trying to respect "good code writing", and using my background in matlab, I tried to split my code as much as possible. It's an intership projet for a company and the Excel sheets are opened on workstations so I need it to be as armored as possible, bug proof and fast. Since I'm studying to become a Mec Engineer, it's not really my domain and I have a lot of questioning about it. Here's my code:

Main:

 ' Changement sur feuille déclenche 2 macros 
    Sub Workbook_sheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Sh.Range("C5:C8")) Is Nothing Then 'Si changement dans les cellules "nom employé"
    
    Call Employe ' Appel Macro pour nom automatique'
    
    End If
    If Not Intersect(Target, Sh.Range("A18:V42")) Is Nothing Then
    
    Call tritroughsheets ' Macro tri des temps d'arret
    
    End If
    Application.EnableEvents = True
    
    End Sub

Module : TritroughSheets

Option Explicit
Sub tritroughsheets()
' Code de classification et comptabilisation des temps d'arrêts et d'attribution des passes selon opérateurs
' Le code appels les fonctions Passes et Arret qui classe respectivement les passes et les arrêts dans le tableau résumé de la semaine

Dim nombrelignezonecomposant As Variant: nombrelignezonecomposant = 25   ' Nombre de ligne disponible pour entrée des pièces
Dim ligneinitzonecomposant As Variant: ligneinitzonecomposant = 18       ' Première ligne d'entrée de no de pièce
Dim nocolonnetype As Variant: nocolonnetype = 22                         ' No de la colonne dans lequel se trouve les types d'arrêt
Dim nocolonneminute As Variant: nocolonneminute = 21                     ' No de la colonne dans lequel se trouve les minutes d'arrêts
Dim ligneinitzonenoemploye As Variant: ligneinitzonenoemploye = 5        ' Première ligne d'entré de no d'opérateur
Dim nombrelignenoemploye As Variant: nombrelignenoemploye = 4            ' Nombre de ligne d'entré de no d'opérateur
Dim nocolnoemploye As Variant: nocolnoemploye = 3                        ' No de la colonne des no d'opérateur
Dim colperte, lignetotperte As Variant: colperte = 13: lignetotperte = 43 ' Position de la case "Total perte"
Dim colpasse, lignepasse As Variant: colpasse = 3: lignepasse = 10       ' Position de la case "Passes"


Application.ScreenUpdating = False

        Call Passes(ligneinitzonenoemploye, nombrelignenoemploye, nocolnoemploye, colperte, lignetotperte, colpasse, lignepasse)
        Call Arret(nombrelignezonecomposant, ligneinitzonecomposant, nocolonnetype, nocolonneminute)


Application.ScreenUpdating = True

End Sub

Passes

Sub Passes(ligneinitzonenoemploye, nombrelignenoemploye, nocolnoemploye, colperte, lignetotperte, colpasse, lignepasse)

Dim nombretravailleur As Integer ' Compteur nombre employé
Dim Employer As Variant          ' Varible nom employée selon boucle
Dim w, q, Z As Integer           ' Compteurs

Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Dim xSh As Worksheet

For Each xSh In Worksheets
    If xSh.Visible Then
        xSh.Select

        For w = 0 To (nombrelignenoemploye - 1) ' Boucle qui passe sur tout les cases d'entrée de nom d'opérateur
        Z = w + ligneinitzonenoemploye
            nombretravailleur = 0                             ' Reset la valeur de nombre d'employe à zero à chaque ittération
            If Cells(Z, nocolnoemploye).Value <> "" Then      ' Si la case est non-vide
                    nombretravailleur = nombretravailleur + 1 ' Ajoute 1 opérateur au total journalier
            End If
                    
        Next
        
        Dim Perte As Variant
        Dim Passe As Variant
        
        If nombretravailleur <> 0 Then                        ' Si le nombre d'opérateur n'est pas 0
            Perte = (Cells(lignetotperte, colperte).Value / nombretravailleur) ' Pertes = tôtal/nombre d'opérateur
            Passe = (Cells(lignepasse, colpasse).Value / nombretravailleur)    ' Passes = tôtal/nombre d'opérateur
        
                    
            Dim MyArray(35, 2) As Variant           ' Création d'une matrice de stockage des passes et pertes par opérateur
                              
            For w = 0 To (nombrelignenoemploye - 1) ' Boucle qui passe sur tout les case d'entrée de nom d'opérateur
            Z = w + ligneinitzonenoemploye
            Employer = Cells(Z, nocolnoemploye).Value            ' À chaque boucle donne à la variable "Employer" la valeur de la case
                    
                If Employer <> "" Then              ' Si la valeur de la case est non-vide
                    
                    For q = 0 To 35
                        If MyArray(q, 0) = 0 Then   ' Si la valeur "employer" de la matrice à cet incrément est nulle
                            MyArray(q, 0) = Employer ' Lui donne le nom de l'employer de la boucle à cette valeur d'incréments
                            MyArray(q, 1) = Passe   ' Lui attribue des passes
                            MyArray(q, 2) = Perte   ' Lui attribue des pertes
                            Exit For                ' Sort de la boucle
                                
                        ElseIf Employer = MyArray(q, 0) Then      ' Autrement si le nom d'employer = au nom de la matrice à l'incrément
                            MyArray(q, 1) = MyArray(q, 1) + Passe ' Ajoute les passes à celles qu'il a déja
                            MyArray(q, 2) = MyArray(q, 2) + Perte ' Ajoute les pertes à celles qu'il a déjà
                            Exit For
                                    
                        Else   ' Si la valeur de la matrice n'est ni 0 ni le même nom d'employer (le nom d'un autre employer)
                                    
                        End If ' Finir la boucle Si
                    Next ' Passer à la case suivante de la matrice
                    
                End If
            Next
        End If
      
    End If
Next
    ' Entrée de données dans le tableau de suivi Hebdomadaire
    Sheets("Vendredi jour").Select
    Worksheets("Vendredi jour").Unprotect
    Cells(9, 36).Value = MyArray(0, 0) ' (x,0) = Employé
    Cells(10, 36).Value = MyArray(1, 0)
    Cells(11, 36).Value = MyArray(2, 0)
    Cells(12, 36).Value = MyArray(3, 0)
    Cells(13, 36).Value = MyArray(4, 0)

    Cells(9, 39).Value = MyArray(0, 1) ' (x,1) = Passes
    Cells(10, 39).Value = MyArray(1, 1)
    Cells(11, 39).Value = MyArray(2, 1)
    Cells(12, 39).Value = MyArray(3, 1)
    Cells(13, 39).Value = MyArray(4, 1)

    Cells(9, 41).Value = MyArray(0, 2) ' (x,2) = Pertes
    Cells(10, 41).Value = MyArray(1, 2)
    Cells(11, 41).Value = MyArray(2, 2)
    Cells(12, 41).Value = MyArray(3, 2)
    Cells(13, 41).Value = MyArray(4, 2)
    Worksheets("Vendredi jour").Protect

    Call sourceSheet.Activate
End Sub

Arrêt

Sub Arret(nombrelignezonecomposant, ligneinitzonecomposant, nocolonnetype, nocolonneminute)
' Sub de classement et comptabilisation des temps d'arrêt
' Le code boucle à travers les colonnes Temps d'arrêt et Type d'arrêt
' Il compare le type d'arrêt et ajoute les minutes au compteur relié au type

Dim Bi, Ci, Di, Ei, Fi, Gi As Variant         ' Compteur semaine
Dim k As Variant: k = ligneinitzonecomposant  ' Incrémentateur ligne
Dim i As Integer                              ' Incrémenteur
Dim typearret As String                       ' Variable type arrêt
Dim B, C, D, E, F, G As Variant

Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
Dim xSh As Worksheet

For Each xSh In Worksheets                  ' Boucle qui passe sur tout les quarts de travail (feuilles)
    If xSh.Visible Then                     ' Condition si feuille visible (éviter feuille caché (cédule)
        xSh.Select

        For i = 0 To (nombrelignezonecomposant - 1)
        k = ligneinitzonecomposant + i
        B = 0: C = 0: D = 0: E = 0: F = 0: G = 0         ' Compteur journalier qui reset à chaque boucle
        
            If Cells(k, nocolonneminute).Value <> 0 Then ' Si la valeur de temps est non-null
            typearret = Cells(k, nocolonnetype).Text     ' Atrtibuer la valeur de type à "typearret"
                If typearret = "B" Then                  ' Boucle Si Typearret = b,c,d,e etc.
                    B = Cells(k, nocolonneminute).Value  ' Attribue la valeur de temps à la variable B,C,D etc.
                ElseIf typearret = "C" Then
                    C = Cells(k, nocolonneminute).Value
                ElseIf typearret = "D" Then
                    D = Cells(k, nocolonneminute).Value
                ElseIf typearret = "E" Then
                    E = Cells(k, nocolonneminute).Value
                ElseIf typearret = "F" Then
                    F = Cells(k, nocolonneminute).Value
                ElseIf typearret = "G" Then
                    G = Cells(k, nocolonneminute).Value
                Else
                End If
                    Bi = Bi + B                         ' Compteurs hebdomadaire
                    Ci = Ci + C
                    Di = Di + D
                    Ei = Ei + E
                    Fi = Fi + F
                    Gi = Gi + G
            End If
        Next
   End If
Next
    Sheets("Vendredi jour").Select
    Worksheets("Vendredi jour").Unprotect
    Cells(15, 38).Value = Bi
    Cells(15, 39).Value = Ci
    Cells(15, 40).Value = Di
    Cells(15, 41).Value = Ei
    Cells(15, 42).Value = Fi
    Cells(15, 43).Value = Gi
    Worksheets("Vendredi jour").Protect
 
    Call sourceSheet.Activate
End Sub

Here are some of my questions/problems:

1. My 2 subs both go through the same loop (trough all sheet if visible). I tried to loop before calling the subs, but the subs in itself need to compile (add) data from every sheet and since subs cannot output data, I was forced to loop in both subs... which is not effective but is it really more effective to use function [y1,...,yN] = myfun(x1,...,xM) and re-input my data every loop or compile outside the sub?

2. I couldn't find another way to assign Pass and Loss (Passes sub) data to Workers without using Array, go it to work but didn't felt logic at first glance.

3. My workbook trigger range is way too big but I couldn't "Union" range in the statement. Reducing the range to my 2 or 3 important rows would most likely trigger it less often, maybe I could split my second statement in 3 different If not intersect?

You guys will most likely find some other upgrade,

Thanks

Answer 1

Remove the Passes and Arrêt parameters and declare them as Global Constants in a public Module.

Public Const nombrelignezonecomposant As Long = 25 'Number of lines available for document entry
Public Const ligneinitzonecomposant As Long = 18       'First part number entry line
Public Const nocolonnetype As Long = 22                          'No of the column in which the types of stop are found
Public Const nocolonneminute As Long = 21                      'No. of the column in which the minutes of stoppages are located
Public Const ligneinitzonenoemploye As Long = 5         'First line of operator number entry
Public Const nombrelignenoemploye As Long = 4             'Number of operator number entry lines
Public Const nocolnoemploye As Long = 3                         'Operator no. Column no.
Rem Position of the "Total loss" box
Public Const colperte  As Long = 13
Public Const ignetotperte  As Long = 43
Rem Position of the "Passes" box
Public Const colpasse  As Long = 3
Public Const lignepasse  As Long = 10

Dim w, q, Z As Integer 

Variables must be Typed individually. There is no advantage to using Integer use Long instead.

Dim w As Long, q As Long, Z As Long

Bi, Ci, Di, Ei, Fi, Gi are unnecessary. Use B, C, D, E, F, G as counters and don't reset them at the beginning of each iteration.

When each clause of a If ElseIf ElseIf block is handling variation of a single value, you should consider using a Select Case statement.

Select Case Cells(k, nocolonnetype).Text
    Case "B"
        B = B + Cells(k, nocolonneminute).Value
    Case "C"
        C = C + Cells(k, nocolonneminute).Value
    Case "D"
        D = D + Cells(k, nocolonneminute).Value
    Case "E"
        E = E + Cells(k, nocolonneminute).Value
    Case "F"
        F = F + Cells(k, nocolonneminute).Value
    Case "G"
        G = G + Cells(k, nocolonneminute).Value
End Select

Avoid Selecting and Activating Objects unless absolutely necessary. Watch: [Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)]

Workbook_SheetChange

Calling tritroughsheets, which even refactored could take 200ms or more, doesn't seem like a good User Experience for me. Consider using Worksheets("Vendredi jour")'s Worksheet_Activate event instead.

Refactored Code

Passes is not included. Too hard to refactor as I don't know French.

Public Module

Option Explicit
Public Const nombrelignezonecomposant As Long = 25 'Number of lines available for document entry
Public Const ligneinitzonecomposant As Long = 18       'First part number entry line
Public Const nocolonnetype As Long = 22                          'No of the column in which the types of stop are found
Public Const nocolonneminute As Long = 21                      'No. of the column in which the minutes of stoppages are located
Public Const ligneinitzonenoemploye As Long = 5         'First line of operator number entry
Public Const nombrelignenoemploye As Long = 4             'Number of operator number entry lines
Public Const nocolnoemploye As Long = 3                         'Operator no. Column no.
Rem Position of the "Total loss" box
Public Const colperte  As Long = 13
Public Const ignetotperte  As Long = 43
Rem Position of the "Passes" box
Public Const colpasse  As Long = 3
Public Const lignepasse  As Long = 10

Sub tritroughsheets()
'Classification code and counting of downtime and allocation of passes according to operators
'The code calls the Pass and Stop functions which respectively classify the passes and stops in the summary table of the week

Application.ScreenUpdating = False

        Call Passes
        Dim Data As Variant
        Data = GetWeeklySummaryData
        UpdateWeelkSummary Data
Application.ScreenUpdating = True

End Sub

Private Function GetWeeklySummaryData() ' Arret Part 1

    'Sub classification and recording of downtime
    'The code loops through the Downtime and Downtime type columns
    'It compares the type of stop and adds the minutes to the counter linked to the type
    Dim i As Long                              ' Incrémenteur

    Dim xSh As Worksheet
    Dim Data As Variant
    Dim Results(0 To 5) As Variant

    For Each xSh In Worksheets                  'Loop that goes on all shifts (sheets)
        If xSh.Visible Then                     'Condition if leaf visible (avoid hidden leaf (schedule)
            Rem Assign Shifts to Data Note: Data is a 2D Base 1 array
            Data = xSh.Cells(ligneinitzonecomposant, nocolonneminute).Resize(nombrelignezonecomposant).Value
            
            For i = 1 To UBound(Data)
                If Data(i, 1).Value <> 0 Then 'If the time value is non-null
                
                    Dim C As Long 'Position of value in Results
                    Select Case Data(i, 2).Text
                        Case "B": C = 0
                        Case "C": C = 1
                        Case "D": C = 2
                        Case "E": C = 3
                        Case "F": C = 4
                        Case "G": C = 5
                    End Select
                    Results(C) = Results(C) + Data(i, 1)
                    
                End If
            Next
        End If
    Next
End Function

Private Sub UpdateWeelkSummary(ByRef Data As Variant)
       With Worksheets("Vendredi jour")
        .Unprotect
        .Cells(15, 38).Resize(ColumnSize:=UBound(Results) + 1).Value = Results
        .Protect
    End With
End Sub

Vendredi jour Code Module

Private Sub Worksheet_Activate()
    Call tritroughsheets
End Sub

---