VBA Debugging Help

LilYawney  Here are the full codes for Module 14, 12, and 11:

Module 14

'TRANSLATION OF MODULE 6
'SERVED FOR THE MANAGEMENT OF THE PRINTING OF THE SECURITY PLAN ONCE IT IS COMPLETED
Dim Sheet_3 As String
Public sheet As String
Private Sub AfterPrint()
     Application.ScreenUpdating = False
     Sheets(1).Activate
     Sheets(sheet).Activate
     Application.ScreenUpdating = True
End Sub

Sub print_Sheet_3()
Application.ScreenUpdating = False
sheet = ActiveSheet.name
Sheet_3 = 1
Call print_sheet_identification(Sheet_3) 'use of "three sheet" to show that it should not be printed directly
Call print_sheet_risk_assessment(Sheet_3) 'in the procedure but wait until the end
Call prints_sheet_hazard_control(Sheet_3)
Sheets(Array("IDENTIFICATION", "Risk Assessment", "Hazard Control")).Select
Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint")
Sheets(sheet).Activate
Cells(5, 3).Select
End Sub
Sub calls_print_sheet_identification() 'is used to call a single sheet print and pass the value
     Sheet_3 = 0 'three sheet which indicates that this is a single print
     Call print_sheet_identification(Sheet_3)
End Sub

Sub call_print_risk_assessment_sheet() 'is used to call a simple sheet printing and to pass the value
     Sheet_3 = 0 'three sheet which indicates that this is a single print
     Call print_sheet_risk_assessment(Sheet_3)
End Sub

Sub calls_print_sheet_hazard_control() 'is used to call a single sheet print and pass the value
     Sheet_3 = 0 'three sheet which indicates that this is a single print
     Call prints_sheet_hazard_control(Sheet_3)
End Sub
Sub calls_print_sheet_memory_help() 'is used to call a single sheet print and pass the value
     Sheet_3 = 0 'three sheet which indicates that this is a single print
     Call print_sheet_memory_help(Sheet_3)
End Sub



Sub print_sheet_identification(Sheet_3)
'
     Sheets("IDENTIFICATION").Activate
     ActiveWorkbook.Worksheets("Hazard Control").Cells(9, 16384) = ActiveSheet.name 'identifies which sheet the print request came from is used to return to it later
     ActiveWorkbook.Worksheets("Hazard Control").Cells(10, 16384) = "" 'will be used to identify that we want to print a single sheet
     Range("A1:P38").Select
     ActiveSheet.PageSetup.PrintArea = "$A$1:$P$38" 'print area definition
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .PrintTitleRows = "$2:$2"
         .PrintTitleColumns = ""
     End With
     Application.PrintCommunication = True
     ActiveSheet.PageSetup.PrintArea = "$A$1:$P$38"
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .LeftHeader = ""
         .CenterHeader = ""
         .RightHeader = ""
         .LeftFooter = ""
         .CenterFooter = ""
         .RightFooter = " &9&P of &N "
         .LeftMargin = Application.InchesToPoints(9.84251968503937E-02)
         .RightMargin = Application.InchesToPoints(9.84251968503937E-02)
         .TopMargin = Application.InchesToPoints(9.84251968503937E-02)
         .BottomMargin = Application.InchesToPoints(9.84251968503937E-02)
         .HeaderMargin = Application.InchesToPoints(0.196850393700787)
         .FooterMargin = Application.InchesToPoints(0.196850393700787)
         .PrintHeadings = False
         .PrintGridrows = False
         '.PrintComments = xlPrintNoComments
         '.PrintComments = False 'xlPrintNoComments
         .PrintQuality = 600
         .CenterHorizontally = False
         .CenterVertically = False
         .Orientation = xlLandscape
         .Draft = False
         .PaperSize = xlPaperLetter
         .FirstPageNumber = xlAutomatic
         .Order = xlDownThenOver
         .BlackAndWhite = False
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 0
         .PrintErrors = xlPrintErrorsDisplayed
         .OddAndEvenPagesHeaderFooter = False
         .DifferentFirstPageHeaderFooter = False
         .ScaleWithDocHeaderFooter = True
         .ArownMarginsHeaderFooter = True
         .EvenPage.LeftHeader.Text = ""
         .EvenPage.CenterHeader.Text = ""
         .EvenPage.RightHeader.Text = ""
         .EvenPage.LeftFooter.Text = ""
         .EvenPage.CenterFooter.Text = ""
         .EvenPage.RightFooter.Text = ""
         .FirstPage.LeftHeader.Text = ""
         .FirstPage.CenterHeader.Text = ""
         .FirstPage.RightHeader.Text = ""
         .FirstPage.LeftFooter.Text = ""
         .FirstPage.CenterFooter.Text = ""
         .FirstPage.RightFooter.Text = ""
     End With
     Application.PrintCommunication = True
    
     If Sheet_3 <> 1 Then 'if the sub was called outside the "print three sheet" sub then we do
         Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") 'show print page
     End If
    


    
End Sub



Sub print_sheet_RISK_ANALYSIS(Sheet_3)
'


     Sheets("Risk Assessment").Activate
     ActiveWorkbook.Worksheets("Hazard Control").Cells(9, 16384) = ActiveSheet.name 'identifies which sheet the print request came from is used to return to it later
     ActiveWorkbook.Worksheets("Hazard Control").Cells(10, 16384) = "" 'will be used to identify that we want to print a single sheet
    
     row = 14
     While Cells(row, 1) <> ""
         row = row + 1
     Wend
     row = row - 1
    
    
     Dim area_print As String
     Let area_print = "A1:P" & row
     ActiveSheet.PageSetup.PrintArea = print_area 'print area definition
    
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .PrintTitleRows = "$1:$13"
         .PrintTitleColumns = ""
     End With
     Application.PrintCommunication = True
   
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .LeftHeader = ""
         .CenterHeader = ""
         .RightHeader = ""
         .LeftFooter = ""
         .CenterFooter = ""
         .RightFooter = " &9&P of &N "
         '.RightFooter = "&9&P of &N"
         .LeftMargin = Application.InchesToPoints(9.84251968503937E-02)
         .RightMargin = Application.InchesToPoints(9.84251968503937E-02)
         .TopMargin = Application.InchesToPoints(9.84251968503937E-02)
         .BottomMargin = Application.InchesToPoints(9.84251968503937E-02)
         .HeaderMargin = Application.InchesToPoints(0.196850393700787)
         .FooterMargin = Application.InchesToPoints(0.196850393700787)
         .PrintHeadings = False
         .PrintGridrows = False
         '.PrintComments = xlPrintNoComments
         '.PrintComments = False 'xlPrintNoComments
         .PrintQuality = 600
         .CenterHorizontally = False
         .CenterVertically = False
         .Orientation = xlLandscape
         .Draft = False
         .PaperSize = xlPaperLetter
         .FirstPageNumber = xlAutomatic
         .Order = xlDownThenOver
         .BlackAndWhite = False
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 0
         .PrintErrors = xlPrintErrorsDisplayed
         .OddAndEvenPagesHeaderFooter = False
         .DifferentFirstPageHeaderFooter = False
         .ScaleWithDocHeaderFooter = True
         .ArownMarginsHeaderFooter = True
         .EvenPage.LeftHeader.Text = ""
         .EvenPage.CenterHeader.Text = ""
         .EvenPage.RightHeader.Text = ""
         .EvenPage.LeftFooter.Text = ""
         .EvenPage.CenterFooter.Text = ""
         .EvenPage.RightFooter.Text = ""
         .FirstPage.LeftHeader.Text = ""
         .FirstPage.CenterHeader.Text = ""
         .FirstPage.RightHeader.Text = ""
         .FirstPage.LeftFooter.Text = ""
         .FirstPage.CenterFooter.Text = ""
         .FirstPage.RightFooter.Text = ""
     End With
     Application.PrintCommunication = True
    
     If Sheet_3 <> 1 Then 'if the sub was called outside the "print three sheet" sub then we do
         Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") 'show print page
     End If
    

End Sub


Sub print_sheet_hazard_control(Sheet_3)
'


     Sheets("Hazard Control").Activate
     ActiveWorkbook.Worksheets("Hazard Control").Cells(9, 16384) = ActiveSheet.name 'identifies which sheet the print request came from is used to return to it later
     ActiveWorkbook.Worksheets("Hazard Control").Cells(10, 16384) = "" 'will be used to identify that we want to print a single sheet
    
    
     greatest_large = WorksheetFunction.Max(a, B)
    
     row = 6 'search for the last row of column A
     While Cells(row, 1) <> ""
         row = row + 1
     Wend
     row = row - 1
     a = row
    
     row = 8 'find last row of column C
     While Cells(row, 3) <> ""
         row = row + 1
     Wend
     row = row - 1
     c = row
    
     P = ActiveWorkbook.Worksheets("Hazard Control").Cells(4, 16384) - 1 'find last row of column p
     s = ActiveWorkbook.Worksheets("Hazard Control").Cells(5, 16384) - 1 ' find last row of column s
   
     row = 6
     While Cells(row, 21) <> "" 'find last row of column u
         row = row + 1
     Wend
     row = row - 1
     u = row
    
     greatest_big = WorksheetFunction.Max(a, c, P, s, u)
    
     Dim area_print As String
     Let print_area = "A1:X" & greater_large
     ActiveSheet.PageSetup.PrintArea = area_print 'definition of the print area
    
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .PrintTitleRows = "$1:$5"
         .PrintTitleColumns = ""
     End With
     Application.PrintCommunication = True
   
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .LeftHeader = ""
         .CenterHeader = ""
         .RightHeader = ""
         .LeftFooter = ""
         .CenterFooter = ""
         .RightFooter = " &9&P of &N "
         '.RightFooter = "&9&P of &N"
         .LeftMargin = Application.InchesToPoints(9.84251968503937E-02)
         .RightMargin = Application.InchesToPoints(9.84251968503937E-02)
         .TopMargin = Application.InchesToPoints(9.84251968503937E-02)
         .BottomMargin = Application.InchesToPoints(9.84251968503937E-02)
         .HeaderMargin = Application.InchesToPoints(0.196850393700787)
         .FooterMargin = Application.InchesToPoints(0.196850393700787)
         .PrintHeadings = False
         .PrintGridrows = False
         '.PrintComments = xlPrintNoComments
         '.PrintComments = False 'xlPrintNoComments
         .PrintQuality = 600
         .CenterHorizontally = False
         .CenterVertically = False
         .Orientation = xlLandscape
         .Draft = False
         .PaperSize = xlPaperLetter
         .FirstPageNumber = xlAutomatic
         .Order = xlDownThenOver
         .BlackAndWhite = False
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 0
         .PrintErrors = xlPrintErrorsDisplayed
         .OddAndEvenPagesHeaderFooter = False
         .DifferentFirstPageHeaderFooter = False
         .ScaleWithDocHeaderFooter = True
         .ArownMarginsHeaderFooter = True
         .EvenPage.LeftHeader.Text = ""
         .EvenPage.CenterHeader.Text = ""
         .EvenPage.RightHeader.Text = ""
         .EvenPage.LeftFooter.Text = ""
         .EvenPage.CenterFooter.Text = ""
         .EvenPage.RightFooter.Text = ""
         .FirstPage.LeftHeader.Text = ""
         .FirstPage.CenterHeader.Text = ""
         .FirstPage.RightHeader.Text = ""
         .FirstPage.LeftFooter.Text = ""
         .FirstPage.CenterFooter.Text = ""
         .FirstPage.RightFooter.Text = ""
     End With
     Application.PrintCommunication = True
    
     If Sheet_3 <> 1 Then 'if the sub was called outside the "print three sheet" sub then we do
         Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") 'show print page
     End If
End Sub

Sub print_sheet_memory_help(Sheet_3)
'

     Sheets("Checklist").Activate
     ActiveWorkbook.Worksheets("Hazard Control").Cells(9, 16384) = ActiveSheet.name 'identifies which sheet the print request came from is used to return to it later
     ActiveWorkbook.Worksheets("Hazard Control").Cells(10, 16384) = "" 'will be used to identify that we want to print a single sheet
    
     Dim col_chk(2) As Variant 'column, A, I and Q)
    col_chk(0) = 1
     col_chk(1) = 9
     col_chk(2) = 17
     i = 0
     row_max = 0
     While i <= 2
         row = 1
         While Cells(row, col_chk(i)) <> ""
             row = row + 1
         Wend
         row = row - 1
         If row > row_max Then
             row_max = row
         End If
         i = i + 1
     Wend
    
    
    
     Dim area_print As String
     Let area_print = "A1:V" & row_max
     ActiveSheet.PageSetup.PrintArea = print_area 'print area definition
    
     Application.PrintCommunication = False
     'With ActiveSheet.PageSetup 'there is no header to print
     '.PrintTitleRows = "$1:$13"
     '.PrintTitleColumns = ""
     'End With
     Application.PrintCommunication = True
   
     Application.PrintCommunication = False
     With ActiveSheet.PageSetup
         .LeftHeader = ""
         .CenterHeader = ""
         .RightHeader = ""
         .LeftFooter = ""
         .CenterFooter = ""
         .RightFooter = "&9&P of &N"
         .LeftMargin = Application.InchesToPoints(9.84251968503937E-02)
         .RightMargin = Application.InchesToPoints(9.84251968503937E-02)
         .TopMargin = Application.InchesToPoints(9.84251968503937E-02)
         .BottomMargin = Application.InchesToPoints(9.84251968503937E-02)
         .HeaderMargin = Application.InchesToPoints(0.196850393700787)
         .FooterMargin = Application.InchesToPoints(0.196850393700787)
         .PrintHeadings = False
         .PrintGridrows = False
         '.PrintComments = xlPrintNoComments
         '.PrintComments = False 'xlPrintNoComments
         .PrintQuality = 600
         .CenterHorizontally = False
         .CenterVertically = False
         .Orientation = xlLandscape
         .Draft = False
         .PaperSize = xlPaperLetter
         .FirstPageNumber = xlAutomatic
         .Order = xlDownThenOver
         .BlackAndWhite = False
         .Zoom = False
         .FitToPagesWide = 1
         .FitToPagesTall = 0
         .PrintErrors = xlPrintErrorsDisplayed
         .OddAndEvenPagesHeaderFooter = False
         .DifferentFirstPageHeaderFooter = False
         .ScaleWithDocHeaderFooter = True
         .ArownMarginsHeaderFooter = True
         .EvenPage.LeftHeader.Text = ""
         .EvenPage.CenterHeader.Text = ""
         .EvenPage.RightHeader.Text = ""
         .EvenPage.LeftFooter.Text = ""
         .EvenPage.CenterFooter.Text = ""
         .EvenPage.RightFooter.Text = ""
         .FirstPage.LeftHeader.Text = ""
         .FirstPage.CenterHeader.Text = ""
         .FirstPage.RightHeader.Text = ""
         .FirstPage.LeftFooter.Text = ""
         .FirstPage.CenterFooter.Text = ""
         .FirstPage.RightFooter.Text = ""
     End With
     Application.PrintCommunication = True
    
     If Sheet_3 <> 1 Then 'if the sub was called outside the "print three sheet" sub then we do
         Application.CommandBars.ExecuteMso ("PrintPreviewAndPrint") 'show print page
     End If
    

End Sub
     

Module 12

'Translation of Module 3

'THIS MODULE IS USED FROM THE RISK ANALYSIS SHEET
'WHEN THE 'CLEAR not APPLICABLE TASKS BUTTON IS CLICKED, THIS MACRO IS CALLED
Dim row_ana, row_mat, row_ctrl_temp, row_ctrl, row_ins, row_for, row_PPE, row_ava As Double

Sub set_task_to_populate_hazard_control()
Application.ScreenUpdating = False
Call clear_tasks_not_applicable
Sheets("ctrl_temp").Activate 'clear sheet data ctrl temp
Call clear_ctrl_sheet
Sheets("Hazard Control").Activate 'clear sheet data means of control
Call clear_ctrl_sheet
Cells(1, 16384) = 0 ' resets the value of the presence indicator of PPE glasses, helmet and boots
Cells(2, 16384) = 0 'use for ASP checkbox to pop in and out as needed only
Cells(3, 16384) = 0
Call copy_PPE_in_temp 'copy the PPE in the temporary control sheet
Call sorting_val_in_temp ' sorts EPIs in the temporary sheet, clears the duplicates and copies in the final sheet
Call find_last_row_written 'finds the last cell written in each of the columns
Call management_particular_case 'adds a checkbox depending on certain dangers or keywords present in the "global matrix"
Call management_case_ASP_Construction 'we add PPE if necessary if the ASP construction box has been checked

End Sub

Sub clear_tasks_not_applicable() 'clear the selected tasks as invalid
                                                 'must also go clear the x in the "global matrix" sheet
row = 14
While Cells(row, 1) <> ""
     If Cells(row, 17) <> "" Then
         Rows(row & ":" & row).Select
         Selection.Clear Shift:=xlUp
         row = row - 1
     End If
     row = row + 1
Wend


End Sub

Sub clear_ctrl_sheet() 'clear all checkboxes except 1 and 2, clear the content
                                         'cells

Dim ole As OLEObject
Dim cb As CheckBox
    

For Each cb In ActiveSheet.CheckBoxes
    
     ChkBoxRow = cb.TopLeftCell.row
     ChkBoxCol = cb.TopLeftCell.Column
     If ChkBoxRow = 6 Or ChkBoxRow = 7 Then
         If ChkBoxCol = 3 Or ChkBoxCol = 4 Then
             GoTo do_not_clear
         End If
     End If
     cb.Clear
do_not_clear:
Next cb

Range("A6:U150").Select 'Clear sheet values
Selection.ClearContents

     With Selection.Interior
         .Pattern = xlNone
         .TintAndShade = 0
         .PatternTintAndShade = 0
     End With



End Sub

Sub copy_PPE_in_temp()
Sheets("Risk Assessment").Activate
row_ana = 14
row_mat = 6
row_ins = 6
row_for = 8
row_PPE = 6
row_ava = 6
row_ctrl = 6

While Cells(row_ana, 26) <> ""
     num_task = Cells(row_ana, 26) 'task number detection
     While ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 26) <> num_task 'search in the global matrix sheet
         row_mat = row_mat + 1
     Wend
     instructions = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 20)
     training = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 21)
     PPE = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 22)
     other_equip = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 23)
     before_start = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 24)
     special_note = ActiveWorkbook.Worksheets("Global Risk Assessment Matrix").Cells(row_mat, 25)
    
     If statements <> "" Then
         Call management_val_mult_instructions 'is used to copy the different items and to manage the presence of the "," as an indicator of
     End If 'more than one value in instructions or training or etc...
     If training <> "" Then
         Call management_val_mult_training
     End If
     If PPE <> "" Then
         Call management_val_mult_PPE
     End If
     If other_equip <> "" Then
         Call management_val_mult_other_equip
     End If
     If before_start <> "" Then
         Call management_val_mult_before_start
     End If
    

     row_mat = 6
     row_ana = row_ana + 1
Wend

End Sub

Sub management_val_mult_instructions()

long_car = Len(statements)
i = 1

While i <= long_car
     i_start = i
     While Mid(statements, i, 1) <> "," And i <= long_char
     i = i + 1
     Wend
     i_end = i
     value = Mid(instructions, i_start, (i_end - i_start))
     ActiveWorkbook.Worksheets("ctrl_temp").Cells(row_ins, 1) = value
     row_ins = row_ins + 1
     i = i + 2
Wend



End Sub

Sub sorting_val_in_temp() 'sort values in each column then clear duplicates
                                                 'adjust row heights

Dim row_max_adjustment As Integer
Dim array_value(500) As String
row_max_adjustment_first = 8
row_max_adjustment = row_max_adjustment_first
Sheets("ctrl_temp").Select
'row_ins = row_ins - 1
'row_for = 8
'row_PPE = 6
'row_ava = 6
'row_ctrl=6
Range("A6:B" & row_ins).Select 'sort column A statement
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
         "A6:A" & row_ins), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
     With ActiveWorkbook.Worksheets("ctrl_temp").Sort
         .SetRange Range("A6:B" & row_ins)
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    
     row = 6 'clear duplicates
     col = 1
     i = 0
     value = Cells(row, col)
     next_val = Cells(row + 1, col)
     While Cells(row, col) <> ""
         While next_val = value And Cells(row, col) <> ""
             row = row + 1
             next_val = Cells(row, col)
         Wend
         If Cells(row, col) <> "" Then 'if we found a different value
             value = Cells(row, col)
             array_value(i) = value
             i = i + 1
             row = row + 1
             next_val = Cells(row, col)
         End If
     Wend
     i_max = i - 1
     If row = 6 Then
         GoTo nothing_to_copy1
     End If
     Sheets("Hazard Control").Select
     row = 6
     i = 0
     col = 1
     While i <= i_max
         Cells(row, col) = array_value(i)
         i = i + 1
         row = row + 1
     Wend
     Clear array_value()
   
     If row - 1 > row_max_adjustment Then 'valid if we have exceeded the row_max where we are adjusting
         row_max_adjustment = row 'the height, if yes we change the value
     End If
        
nothing_to_copy1:
Sheets("ctrl_temp").Select

Range("C8:I" & row_for).Select 'sort of column C training
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
         "C8:C" & row_for), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
     With ActiveWorkbook.Worksheets("ctrl_temp").Sort
         .SetRange Range("C8:I" & row_for)
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    
     row = 8
     col = 3 ' clear duplicates
     i = 0
     value = Cells(row, col)
     next_val = Cells(row + 1, col)
     While Cells(row, col) <> ""
         While next_val = value And Cells(row, col) <> ""
             row = row + 1
             next_val = Cells(row, col)
         Wend
         If Cells(row, col) <> "" Then 'if we found a different value
             value = Cells(row, col)
             array_value(i) = value
             i = i + 1
             row = row + 1
             next_val = Cells(row, col)
         End If
      
     Wend
     i_max = i - 1
     If row = 8 Then
         GoTo nothing_to_copy2
     End If
    
     Sheets("Hazard Control").Select
    
     row = 8
     i = 0
     col = 3
     While i <= i_max
         Cells(row, col) = array_value(i)
         i = i + 1
         row = row + 1
     Wend
     Clear array_value()
    
     If row - 1 > row_max_adjustment Then 'valid if we have exceeded the row_max where we are adjusting
         row_max_adjustment = row 'the height, if yes we change the value
     End If

nothing_to_copy2:
Sheets("ctrl_temp").Select

Range("P6:R" & row_PPE).Select 'sort of column PPE
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Clear
     ActiveWorkbook.Worksheets("ctrl_temp").Sort.SortFields.Add Key:=Range( _
         "P6:P" & row_PPE), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
         xlSortNormal
     With ActiveWorkbook.Worksheets("ctrl_temp").Sort
         .SetRange Range("P6:R" & row_PPE)
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
    
     row = 6
     Column = 16
     i = 0
     value = Cells(row, col)
     next_val = Cells(row + 1, col)
     While Cells(row, col) <> ""
         While next_val = value And Cells(row, col) <> ""
             row = row + 1
             next_val = Cells(row, col)
         Wend
         If Cells(row, col) <> "" Then 'if a different value was found
             value = Cells(row, col)
             array_value(i) = value

Module 11

'Translation of Module 1
'THIS MODULE IS USED TO POPULATE THE RISK Assessment FROM THE CHECK SHEET AND USING THE DATA
'OF THE GLOBAL MATRIX SHEET

Dim row As Double
Sub plan_management()
Application.ScreenUpdating = True

Call clears_selection_global_matrix
Call selection_risk
Call clear_the_rows
Call addition_danger
Call reset_the_filter_to_all_values

Sheets("Risk Assessment").Select
Cells(14, 1).Select

Application.ScreenUpdating = True

End Sub

Sub clear_selection_global_matrix() 'clear the "x"s already indicated above

Application.ScreenUpdating = False
Dim wsam As Worksheet 'Checklist sheet
Dim wsmg As Worksheet 'Global Assessment Matrix sheet
Dim rng_clear As Range

Set wsam = Worksheets("Checklist")
Set wsmg = Worksheets("Global Risk Assessment Matrix")

row = 6
row_start = 6

While wsmg.Cells(row, 2) <> ""
row = row + 1
Wend

row_end = row
wsmg.Range("A" & row_start - 1 & ":S" & row_end).AutoFilter field:=18, Criteria:="<>" 'corresponds to the fourth filter
'example if B And C are filtered column C is the 2nd. A to S are filtered S is the 19
Set rng_clear = wsmg.Range("S" & row_start & ":S" & row_end)
rng_clear.ClearContents

End Sub

Sub clear_rows()

Application.ScreenUpdating = False

Dim wsam As Worksheet   'Checklist sheet
Dim wsmg As Worksheet   'Global Assessment Matrix sheet
Dim wsar As Worksheet   'Risk Assessment sheet
Dim rng_clear As Range

Set wsam = Worksheets("Checklists")
Set wsmg = Worksheets("Global Risk Assessment Matrix")
Set wsar = Worksheets("Risk Assessment")

row = 14
col = 1
row_e = 6

While wsar.Cells(row, col) <> ""

risk_val = wsar.Cells(row, col)
risk_matrix_val = wsmg.Cells(row_e, 2)

While wsmg.Cells(row_e, 2) <> "" 'while there are rows in the sheet
While risk_val <> risk_matrix_val And wsmg.Cells(row_e, 2) <> ""

row_e = row_e + 1
risk_matrix_val = wsmg.Cells(row_e, 2)
Wend

If risk_val = risk_matrix_val And wsmg.Cells(row_e, 19) = "x" Then
GoTo danger_present:    'we do not clear the danger because it is selected

Else
wsar.Range(row & ":" & row).Clear xlUp

GoTo danger_clear:

End If

Wend

danger_present:
row = row + 1
danger_clear:
row_e = 6
Wend

End Sub

Sub risk_selection()

Application.ScreenUpdating = False

Call column_selection

End Sub

Sub column_selection()

Sheets("Checklist").Select

Dim wsam As Worksheet   'Checklist sheet
Dim wsmg As Worksheet   'Global Assessment Matrix sheet

Set wsam = Worksheets("Checklist")
Set wsmg = Worksheets("Global Risk Assessment Matrix")

row = 2
row_end = 200  'MAXIMUM NUMBER OF rows IN THE SHEET Checklist
col = 7
col_end = 8 'if we have more than one column for tasks, we must put the last column where there are tasks
row_e = 6

While col < col_end
row = 2

While row <= row_end

If wsam.Cells(row, col) = True Then
risk_val = wsam.Cells(row, col + 1)
risk_matrix_val = wsmg.Cells(row_e, 2)

While wsmg.Cells(row_e, 2) <> ""  'while there are rows in the sheet

While risk_val <> risk_matrix_val And wsmg.Cells(row_e, 2) <> ""
row_e = row_e + 1
risk_matrix_val = wsmg.Cells(row_e, 2)
Wend

If risk_val = risk_matrix_val Then
wsmg.Cells(row_e, 19) = "x"
End If

row_e = row_e + 1
risk_matrix_val = wsmg.Cells(row_e, 2)
Wend

row_e = 6
End If

row = row + 1
Wend

col = col + 1
Wend

End:

End Sub

Sub count_number_row_add()

Application.ScreenUpdating = False
Sheets("Global Risk Assessment Matrix").Select

row_e = 6

Dim missing_row As Double
Dim row As Integer

While Cells(row_e, 2) <> "" 'finds x's in the entire Global Risk Assessment Matrix sheet and counts them
If Cells(row_e, 19) <> "" Then
End If

row_e = row_e + 1
Wend

Sheets("Risk Assessment").Select    'count the number of rows available
row = 14

While Cells(row, 1) <> "END OF RISKS"
row_available = row_available + 1
row = row + 1
Wend

row_end = row
missing_row = number_danger - row_available + 2 'valid if rows are missing

While Cells(row, 1) <> "ROW TO INSERT"
row = row + 1 'find the pattern row
Wend

row_model = row + 1

If missing_row > 0 Then 'insert missing rows if any are missing
row_to_insert = row_end - 2
nb_row_to_insert = missing_row + 10
i = 0

While i <= nb_row_to_insert
Rows(row_model & ":" & row_model).Select

Application.CutCopyMode = False

Selection.Copy
Rows(row_to_insert & ":" & row_to_insert).Select
Selection.Insert Shift:=xlDown

row_model = row_model + 1
i = i + 1
Wend

End If

End Sub

Sub add_danger()

Application.ScreenUpdating = False
Dim row As Double
Dim row_e As Double
Dim wsam As Worksheet   'Checklist sheet
Dim wsmg As Worksheet   'Global Assessment Matrix sheet
Dim wsar As Worksheet   'Risk Assessment sheet
Dim rng_clear As Range

Set wsam = Worksheets("Checklist")
Set wsmg = Worksheets("Global Risk Assessment Matrix")
Set wsar = Worksheets("Risk Assessment")

row = 6
row_e = 14
'row_e_max=44  'maximum number of rows containing the code for the risk Assessment add rows if it exceeds
'not coded yet

While wsmg.Cells(row, 2) <> "" 'search the entire global Assessment matrix sheet
row_e = 14 'row indicator in the risk Assessment sheet
If wsmg.Cells(row, 19) <> "" Then 'search for a row marked with an x
task_num = wsmg.Cells(row, 1)
task = wsmg.Cells(row, 2)
hazard = wsmg.Cells(row, 4)
responsible = wsmg.Cells(row, 5)
serious_initiate = wsmg.Cells(row, 6)
problem_initiate = wsmg.Cells(row, 7)
Average = wsmg.Cells(row, 9)
serious_count = wsmg.Cells(row, 10)
problem_count = wsmg.Cells(row, 11)

    'search for the danger value to see if it exists

risk_value_of_hazard = wsar.Cells(row_e, 1)
While risk_value_of_hazard <> task And wsar.Cells(row_e, 1)

search_for_other_similar_hazard:
row_e = row_e + 1
risk_value_of_hazard = wsar.Cells(row_e, 1)
Wend

'if InStr(1,risk_value_of_hazard,hazard,vbTextCompare)=1 then
If risk_value_of_hazard = task Then
task_in_risk = wsar.Cells(row_e, 2)
If task_in_risk = hazard Then 'if the hazard and the task are identical we say "already present"
GoTo hazard_already_present

Else
GoTo seek_other_similar_hazard  'if the task is different, we are looking for the same hazard but with another task

End If

End If

last_row_written = row_e
row_e = 14 'if the hazard has not been found
While wsar.Cells(row_e, 1) <> ""
row_e , row_e + 1 'detection of an empty row in the risk Assessment worksheet
Wend

wsar.Cells(row_e, 26) = task_num
wsar.Cells(row_e, 1) = task
wsar.Cells(row_e, 2) = hazard
wsar.Cells(row_e, 4) = serious_initiate
wsar.Cells(row_e, 5) = problem_initiate
wsar.Cells(row_e, 7) = Average
wsar.Cells(row_e, 11) = responsible
wsar.Cells(row_e, 14) = serious_count
wsar.Cells(row_e, 15) = problem_count
End If

hazard_already_present
row = row + 1
Wend

wsmg.Range("$B$5:$S$169").AutoFilter field:=18  'corresponds to the filter number
'example if B and C are filtered column C is the 2nd. A to S are filtered S is the 19

'sheets("Risk Assessment").select   'adjust cell height
'wsar.Cells(14,1).select

row_start = 14
row_h = row_start
While wsar.Cells(row_h, 1) <> 0

row_h = row_h + 1
Wend

Set rng_clear = wsar.Rows(row_start & ":" & row_h)
'range("A" & row_h & ":P" & row_h).entirerow.autofit
'rows(row_start & ":" & row_h).select
'selection.rowheight=90
rng_clear.RowHeight = 90
'wsar.cells(14,1).select

Application.ScreenUpdating = True

End Sub

Sub reset_the_filter_to_all_vales()    'in the Global Risk Assessment Matrix sheet

'column S resests the filter to all values
Application.ScreenUpdating = False

Dim wsam As Worksheet   'Checklist sheet
Dim wsmg As Worksheet   'Global Risk Assessment Matrix sheet
Dim wsar As Worksheet   'Risk Analysis sheet
Dim rng_clear As Range

Set wsmg = Worksheets("Global Risk Assessment Matrix")
row = 6
row_start = 6

While wsmg.Cells(row, 2) <> ""
row = row + 1
Wend

row_end = row

wsmg.Range("A" & row_start - 1 & ":S" & row_end).AutoFilter field:=18 'corresponds to the filter number
'example if B and C are filtered column C is the 2nd. A to S are filtered S is the 19

End Sub