MODULE 1 CODE

Sub Button1_Click()

Call UnProtectWorkbook

Call ClearAndDeleteSheets(False)

Call ProtectWorkbook

End Sub

Sub Button2_Click()

Call UnProtectWorkbook

Call ClearAndDeleteSheets(True)

' --- create sheets in this order ---

Call CreateLSSheet ' LS (single weight)

Call CreateFixedWTSheet

Call CreateFixedWT_DISSheet

Call CreateTankSheet

Call CreateFLDSheet

Call CreateCRTSheet

Call CreateLS_DISSheet ' <-- NEW, distribution page (before LS_LMT)

Call CreateLS_LMTSheet ' limits (after LS_DIS)

Call CreateLS_SLVSheet

Call CreateINT_CRISheet

Call CreateINT_SLVSheet

Call CreateINT_WD_CRISheet

Call CreateINT_WD_SLVSheet

Call CreateCOMSheet

Call CreateDMGSheet
 Call CreateDMG_CRISheet

Call CreateDMG_SLVSheet

Call ProtectWorkbook

[Link]("GEN").Activate

End Sub

Sub Button3_Click()

Call [Link]

End Sub

Sub Button4_Click()

Call [Link]

End Sub

Sub ClearAndDeleteSheets(deleteSheetOnly As Boolean)

Dim ws As Worksheet

Dim wsCurrent As Worksheet

Dim i As Long

Set wsCurrent = [Link]

If Not deleteSheetOnly Then

[Link]("C3:Q3").ClearContents

[Link]("C5:Q5").ClearContents

[Link]("C7:Q7").ClearContents

[Link]("C9:Q9").ClearContents

[Link]("C11:Q11").ClearContents
 End If

[Link] = False

For i = [Link] To 1 Step -1

Set ws = [Link](i)

If [Link] <> [Link] Then

[Link]

End If

Next i

[Link] = True

End Sub

Sub CreateCOMSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("COM").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "COM"
 Dim newSheet As Worksheet

Set newSheet = [Link]("COM")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Compartment Name"

[Link]("B1").value = "Permeability"

[Link]("A1:B1").[Link] = True

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("B:B").ColumnWidth = 150 / [Link]

Call AllowNumberOnly([Link]("B2:B1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub CreateFixedWTSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("F_WT").Delete

On Error GoTo 0

[Link] = True
 [Link](After:=[Link]([Link])).Name
= "F_WT"

Dim newSheet As Worksheet

Set newSheet = [Link]("F_WT")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Name"

[Link]("B1").value = "Weight (MT)"

[Link]("C1").value = "LCG (m)"

[Link]("D1").value = "TCG (m)"

[Link]("E1").value = "VCG (m)"

[Link]("F1").value = "Note"

[Link]("A1:F1").[Link] = True

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("B:B").ColumnWidth = 150 / [Link]

[Link]("C:C").ColumnWidth = 230 / [Link]

[Link]("D:D").ColumnWidth = 230 / [Link]

[Link]("E:E").ColumnWidth = 230 / [Link]

[Link]("F:F").ColumnWidth = 400 / [Link]

Call AllowNumberOnly([Link]("B2:E1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:F1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:F1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:F1048576"))

End Sub
Sub CreateFixedWT_DISSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]("GEN")

Dim no As Integer

If [Link]("C11").value = Empty Then

no = 0

Else

no = [Link]("C11").value

End If

If no > 0 Then

For i = 1 To no

[Link] = False

On Error Resume Next

[Link]("F_WT_DIS" & i).Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name =
"F_WT_DIS" & i

Dim newSheet As Worksheet

Set newSheet = [Link]("F_WT_DIS" & i)

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Name"
[Link]("A4").value = "Note"

[Link]("C1").value = "Weight (MT)"

[Link]("D1").value = "Location (m)"

[Link]("E1").value = "TCG (m)"

[Link]("F1").value = "VCG (m)"

[Link]("A1:F1").[Link] = True

[Link]("A4").[Link] = True

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("C:C").ColumnWidth = 230 / [Link]

[Link]("D:D").ColumnWidth = 230 / [Link]

[Link]("E:E").ColumnWidth = 230 / [Link]

[Link]("F:F").ColumnWidth = 230 / [Link]

Call AllowNumberOnly([Link]("C2:F1048576"))

Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("A5"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("C2:D1048576"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("E2:F2"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("A4:A5"))

Call ApplyBorders([Link]("C1:D1048576"))

Call ApplyBorders([Link]("E1:F2"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2"))

Call ProtectSheetExceptRange(newSheet, [Link]("A5"))

 Call ProtectSheetExceptRange(newSheet, [Link]("C2:D1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("E2:F2"))

Next i

End If

End Sub

Sub CreateFLDSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("FLD").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "FLD"

Dim newSheet As Worksheet

Set newSheet = [Link]("FLD")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Name"

[Link]("B1").value = "Compartment Name"

[Link]("C1").value = "Longi. Location (m)"

 [Link]("D1").value = "Trans. Location (m)"

[Link]("E1").value = "Verti. Location (m)"

[Link]("F1").value = "Note"

[Link]("A1:F1").[Link] = True

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("B:B").ColumnWidth = 200 / [Link]

[Link]("C:C").ColumnWidth = 200 / [Link]

[Link]("D:D").ColumnWidth = 200 / [Link]

[Link]("E:E").ColumnWidth = 200 / [Link]

[Link]("F:F").ColumnWidth = 400 / [Link]

Call AllowNumberOnly([Link]("C2:E1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:F1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:F1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:F1048576"))

End Sub

Sub CreateCRTSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("CRT").Delete

On Error GoTo 0

[Link] = True
 [Link](After:=[Link]([Link])).Name
= "CRT"

Dim newSheet As Worksheet

Set newSheet = [Link]("CRT")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Name"

[Link]("B1").value = "Compartment Name"

[Link]("C1").value = "Longi. Location (m)"

[Link]("D1").value = "Trans. Location (m)"

[Link]("E1").value = "Verti. Location (m)"

[Link]("F1").value = "Note"

[Link]("A1:F1").[Link] = True

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("B:B").ColumnWidth = 200 / [Link]

[Link]("C:C").ColumnWidth = 200 / [Link]

[Link]("D:D").ColumnWidth = 200 / [Link]

[Link]("E:E").ColumnWidth = 200 / [Link]

[Link]("F:F").ColumnWidth = 400 / [Link]

Call AllowNumberOnly([Link]("C2:E1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:F1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:F1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:F1048576"))

End Sub

Sub CreateINT_CRISheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("INT_CRI").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "INT_CRI"

Dim newSheet As Worksheet

Set newSheet = [Link]("INT_CRI")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Title"

[Link]("C1").value = "Intact Criteria"

[Link]("D1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("C:C").ColumnWidth = 600 / [Link]

[Link]("D:D").ColumnWidth = 400 / [Link]

 Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("C2:D1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("C1:D1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2"))

Call ProtectSheetExceptRange(newSheet, [Link]("C2:D1048576"))

End Sub

Sub CreateINT_SLVSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("INT_SLV_SET").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "INT_SLV_SET"

Dim newSheet As Worksheet

Set newSheet = [Link]("INT_SLV_SET")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Settings"
 [Link]("B1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("B:B").ColumnWidth = 400 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub CreateDMG_SLVSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("DMG_SLV_SET").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "DMG_SLV_SET"

Dim newSheet As Worksheet

Set newSheet = [Link]("DMG_SLV_SET")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

 [Link]("A1").value = "Settings"

[Link]("B1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("B:B").ColumnWidth = 400 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub CreateINT_WD_SLVSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("INT_WD_SLV_SET").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "INT_WD_SLV_SET"

Dim newSheet As Worksheet

Set newSheet = [Link]("INT_WD_SLV_SET")

 Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Settings"

[Link]("B1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("B:B").ColumnWidth = 400 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub CreateLS_SLVSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("LS_SLV_SET").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "LS_SLV_SET"

Dim newSheet As Worksheet

Set newSheet = [Link]("LS_SLV_SET")

 Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Settings"

[Link]("B1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("B:B").ColumnWidth = 400 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub CreateDMG_CRISheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("DMG_CRI").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "DMG_CRI"

Dim newSheet As Worksheet

 Set newSheet = [Link]("DMG_CRI")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Title"

[Link]("C1").value = "Damage Criteria"

[Link]("D1").value = "Note"

[Link]("A1:E1").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("C:C").ColumnWidth = 600 / [Link]

[Link]("D:D").ColumnWidth = 400 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("C2:D1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("C1:D1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2"))

Call ProtectSheetExceptRange(newSheet, [Link]("C2:D1048576"))

End Sub

Sub CreateINT_WD_CRISheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("INT_WD_CRI").Delete

On Error GoTo 0
 [Link] = True

[Link](After:=[Link]([Link])).Name
= "INT_WD_CRI"

Dim newSheet As Worksheet

Set newSheet = [Link]("INT_WD_CRI")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Title"

[Link]("A4").value = "Wind Pressure"

[Link]("A7").value = "Gust"

[Link]("C1").value = "Wind Criteria"

[Link]("D1").value = "Note"

[Link]("A1:F1").[Link] = True

[Link]("A4").[Link] = True

[Link]("A7").[Link] = True

[Link]("A:A").ColumnWidth = 400 / [Link]

[Link]("C:C").ColumnWidth = 600 / [Link]

[Link]("D:D").ColumnWidth = 400 / [Link]

Call AllowNumberOnly([Link]("A5"))

Call AllowNumberOnly([Link]("A8"))

Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("A5"), RGB(248, 203, 173))

 Call ColorCellsOrangeAccent2([Link]("A8"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("C2:D1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("A4:A5"))

Call ApplyBorders([Link]("A7:A8"))

Call ApplyBorders([Link]("C1:D1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2"))

Call ProtectSheetExceptRange(newSheet, [Link]("A5"))

Call ProtectSheetExceptRange(newSheet, [Link]("A8"))

Call ProtectSheetExceptRange(newSheet, [Link]("C2:D1048576"))

End Sub

Sub CreateLS_LMTSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("LS_LMT").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "LS_LMT"

Dim newSheet As Worksheet

Set newSheet = [Link]("LS_LMT")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Bulkhead Frame"

[Link]("B1").value = "Longi. Location (m)"

[Link]("C1").value = "BM Sea Hog (T-m)"

[Link]("D1").value = "BM Sea Sag (T-m)"

[Link]("E1").value = "BM Port Hog (T-m)"

[Link]("F1").value = "BM Port Sag (T-m)"

[Link]("G1").value = "SF Sea Positive (T)"

[Link]("H1").value = "SF Sea Negative (T)"

[Link]("I1").value = "SF Port Positive (T)"

[Link]("J1").value = "SF Port Negative (T)"

[Link]("K1").value = "Note"

[Link]("A1:K1").[Link] = True

[Link]("A:A").ColumnWidth = 150 / [Link]

[Link]("B:B").ColumnWidth = 150 / [Link]

[Link]("C:C").ColumnWidth = 150 / [Link]

[Link]("D:D").ColumnWidth = 150 / [Link]

[Link]("E:E").ColumnWidth = 150 / [Link]

[Link]("F:F").ColumnWidth = 150 / [Link]

[Link]("G:G").ColumnWidth = 150 / [Link]

[Link]("H:H").ColumnWidth = 150 / [Link]

[Link]("I:I").ColumnWidth = 150 / [Link]

[Link]("J:J").ColumnWidth = 150 / [Link]

 [Link]("K:K").ColumnWidth = 400 / [Link]

Call AllowNumberOnly([Link]("A2:J1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:K1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:K1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:K1048576"))

End Sub

Sub CreateLSSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("LS").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "LS"

Dim newSheet As Worksheet

Set newSheet = [Link]("LS")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Light Ship Type"

With [Link]("A2").Validation
 .Delete ' Clear any existing validation

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween, Formula1:="Light Ship Weight,Light Ship Distribution"

.IgnoreBlank = True

.InCellDropdown = True

.ShowInput = True

.ShowError = True

End With

[Link]("A1:G1").[Link] = True

[Link]("A2").value = "Light Ship Weight"

End Sub

Sub LightshipWeightEntry(sheet As Worksheet)

Call DeleteRange(sheet, [Link]("C:G"))

[Link]("C1").value = "Weight (MT)"

[Link]("D1").value = "LCG (m)"

[Link]("E1").value = "TCG (m)"

[Link]("F1").value = "VCG (m)"

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("C:C").ColumnWidth = 130 / [Link]

[Link]("D:D").ColumnWidth = 230 / [Link]

[Link]("E:E").ColumnWidth = 230 / [Link]

[Link]("F:F").ColumnWidth = 230 / [Link]

[Link]("A1:G1").[Link] = True

Call AllowNumberOnly([Link]("C2:F2"))

Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

 Call ColorCellsOrangeAccent2([Link]("C2:F2"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("C1:F2"))

Call ProtectSheetExceptRange(sheet, [Link]("A2"))

Call ProtectSheetExceptRange(sheet, [Link]("C2:F2"))

End Sub

Sub CreateDMGSheet()

Dim mainSheet As Worksheet

Set mainSheet = [Link]

[Link] = False

On Error Resume Next

[Link]("DMG").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "DMG"

Dim newSheet As Worksheet

Set newSheet = [Link]("DMG")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Case No"

[Link]("B1").value = "Damaged Compartments (Separated by comma)"

 [Link]("A1:B1").[Link] = True

[Link]("A:A").ColumnWidth = 150 / [Link]

[Link]("B:B").ColumnWidth = 800 / [Link]

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(newSheet, [Link]("A2:B1048576"))

End Sub

Sub LightshipDistributionEntry(sheet As Worksheet)

Call DeleteRange(sheet, [Link]("C:G"))

[Link]("C1").value = "Weight per m (MT/m)"

[Link]("D1").value = "Location (m) from AP, Fwd +ve"

[Link]("E1").value = "TCG (m)"

[Link]("F1").value = "VCG (m)"

[Link]("A:A").ColumnWidth = 200 / [Link]

[Link]("C:C").ColumnWidth = 170 / [Link]

[Link]("D:D").ColumnWidth = 250 / [Link]

[Link]("E:E").ColumnWidth = 230 / [Link]

[Link]("F:F").ColumnWidth = 230 / [Link]

[Link]("A1:G1").[Link] = True

Call AllowNumberOnly([Link]("C2:D1048576"))

Call AllowNumberOnly([Link]("E2:F2"))

Call ColorCellsOrangeAccent2([Link]("A2"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("C2:D1048576"), RGB(248, 203, 173))

Call ColorCellsOrangeAccent2([Link]("E2:F2"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:A2"))

Call ApplyBorders([Link]("C1:D1048576"))
 Call ApplyBorders([Link]("E1:F2"))

Call ProtectSheetExceptRange(sheet, [Link]("A2"))

Call ProtectSheetExceptRange(sheet, [Link]("C2:D1048576"))

Call ProtectSheetExceptRange(sheet, [Link]("E2:F2"))

End Sub

Sub CreateTankSheet()

[Link] = False

On Error Resume Next

[Link]("TK").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "TK"

Dim ws As Worksheet: Set ws = [Link]("TK")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Tank Name"

[Link]("B1").value = "Percentage (0-100)"

[Link]("C1").value = "Weight (MT)"

[Link]("D1").value = "Volume (m3)"

[Link]("E1").value = "FSM (e.g. MAX)"

[Link]("F1").value = "Note"

[Link]("G1").value = "Contents Label (group)"

[Link]("H1").value = "SG (Specific Gravity)"

 [Link]("A1:H1").[Link] = True

[Link]("A").ColumnWidth = 150 / [Link]

[Link]("B").ColumnWidth = 160 / [Link]

[Link]("C").ColumnWidth = 150 / [Link]

[Link]("D").ColumnWidth = 150 / [Link]

[Link]("E").ColumnWidth = 150 / [Link]

[Link]("F").ColumnWidth = 300 / [Link]

[Link]("G").ColumnWidth = 200 / [Link]

[Link]("H").ColumnWidth = 130 / [Link]

Call AllowZeroToHundradOnly([Link]("B2:B1048576"))

Call AllowNumberOnly([Link]("C2:D1048576"))

Call AllowNumberOnly([Link]("H2:H1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:H1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:H1048576"))

Call ProtectSheetExceptRange(ws, [Link]("A2:H1048576"))

End Sub

Sub AllowNumberOnly(rng As Range)

With [Link]

.Delete ' Clear existing validation first

.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween, Formula1:=-999999999, Formula2:=999999999

.IgnoreBlank = True

.InCellDropdown = False
 .ShowInput = True

.ShowError = True

.InputMessage = "Please enter a number only."

.ErrorMessage = "Invalid entry! Please enter a valid number."

End With

End Sub

Sub AllowZeroToHundradOnly(rng As Range)

With [Link]

.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween, Formula1:=0, Formula2:=100 ' Adjust range as needed

.IgnoreBlank = True

.InCellDropdown = False

.ShowInput = True

.InputMessage = "Please enter a number between 0 and 100."

.ErrorMessage = "Invalid entry! Please enter a valid number between 0 and 100."

.ShowError = True

End With

End Sub

Sub AllowPositiveInteger(rng As Range)

With [Link]

.Add Type:=xlValidateWholeNumber, AlertStyle:=xlValidAlertStop, _

Operator:=xlBetween, Formula1:=0, Formula2:=10000 ' Adjust range as needed

.IgnoreBlank = True

.InCellDropdown = False

.ShowInput = True

.InputMessage = "Please enter a whole number between 0 and 10000."

 .ErrorMessage = "Invalid entry! Please enter a valid whole number between 0 and 10000."

.ShowError = True

End With

End Sub

Sub ColorCellsOrangeAccent2(rng As Range, themeColor As Long)

[Link] = themeColor

End Sub

Sub ApplyBorders(rng As Range)

With [Link]

.LineStyle = xlContinuous

.Color = RGB(0, 0, 0) ' Black color for borders

.Weight = xlThin ' Thin border

End With

End Sub

Sub ProtectSheetExceptRange(sheet As Worksheet, rngToUnlock As Range)

[Link] "Sidhu230398"

[Link] = False

[Link] "Sidhu230398"

[Link] = xlUnlockedCells

End Sub

Sub DeleteRange(sheet As Worksheet, rngToUnlock As Range)

[Link] "Sidhu230398"

[Link]

[Link] = xlUnlockedCells

End Sub

Sub ProtectWorkbook()
 [Link] "Sidhu230398"

End Sub

Sub UnProtectWorkbook()

[Link] "Sidhu230398"

End Sub

Sub CreateLS_DISSheet()

[Link] = False

On Error Resume Next

[Link]("LS_DIS").Delete

On Error GoTo 0

[Link] = True

[Link](After:=[Link]([Link])).Name
= "LS_DIS"

Dim ws As Worksheet: Set ws = [Link]("LS_DIS")

Call ColorCellsOrangeAccent2([Link]("A1:ZZ1048576"), RGB(244, 176, 132))

[Link]("A1").value = "Weight per m (MT/m)"

[Link]("B1").value = "Longi. Location (m) from AP, Fwd +ve"

[Link]("A1").[Link] = True

[Link]("B1").[Link] = True

[Link]("A:A").ColumnWidth = 170 / [Link]

[Link]("B:B").ColumnWidth = 250 / [Link]

Call AllowNumberOnly([Link]("A2:A1048576"))
 Call AllowNumberOnly([Link]("B2:B1048576"))

Call ColorCellsOrangeAccent2([Link]("A2:B1048576"), RGB(248, 203, 173))

Call ApplyBorders([Link]("A1:B1048576"))

Call ProtectSheetExceptRange(ws, [Link]("A2:B1048576"))

End Sub

Module 2 code

Sub ChecksBeforeCMDGen()

If DamageCaseCheck = True Then

If PermeabilityMatchCheck = True Then

If DISMatchCheck = True Then

If PermeabilityCheck = True Then

Call [Link]

End If

Else

MsgBox ("Please check Light Ship Distribution check check. Weigh per meter row not matching
with location row!")

End If

Else

MsgBox ("Please check compartmrnt permeability check. Compartment row not matching with
permeability row!")

End If

Else

MsgBox ("Please check damage cases. Damage Compartment row not matching with case no row!")

End If

End Sub

Function DamageCaseCheck() As Boolean

 Dim lastRow As Interior

Dim ws As Worksheet

Set ws = [Link]("DMG")

If [Link]([Link], "A").End(xlUp).Row <> [Link]([Link], "B").End(xlUp).Row Then

DamageCaseCheck = False

Else

DamageCaseCheck = True

End If

End Function

Function PermeabilityCheck() As Boolean

PermeabilityCheck = True

Dim rng As Range

Dim rng_Com As Range

Dim lastRow As Long

Dim lastRow_Com As Long

Dim ws As Worksheet

Dim ws_Com As Worksheet

Set ws = [Link]("DMG")

Set ws_Com = [Link]("COM")

lastRow = [Link]([Link], "A").End(xlUp).Row

lastRow_Com = ws_Com.Cells(ws_Com.[Link], "A").End(xlUp).Row

Set rng = [Link]("A2:B" & lastRow)

Set rng_Com = ws_Com.Range("A2:B" & lastRow_Com)

For i = 1 To lastRow - 1

Dim caseno As Integer

Dim damagedstring As String

Dim part As Variant

 Dim damageParts() As String ' Array to hold split parts

caseno = [Link](i, 1).value

damagedstring = [Link](i, 2).value

' Split the damagedstring using comma as a delimiter

damageParts = Split(damagedstring, ",")

Dim matchFound As Variant

For j = LBound(damageParts) To UBound(damageParts)

part = damageParts(j)

If MatchCheck(part, rng_Com) = False Then

PermeabilityCheck = False

MsgBox ("Case No: " & caseno & " - Part '" & part & "' NOT found in COM sheet.")

End If

Next j

Next i

End Function

Function MatchCheck(val As Variant, rng As Range) As Boolean

MatchCheck = False

For i = 1 To [Link]

If [Link](i, 1).value = val Then

MatchCheck = True

Exit For

End If

Next i

End Function

Function PermeabilityMatchCheck() As Boolean

Dim lastRow As Interior

 Dim ws As Worksheet

Set ws = [Link]("COM")

If [Link]([Link], "A").End(xlUp).Row <> [Link]([Link], "B").End(xlUp).Row Then

PermeabilityMatchCheck = False

Else

PermeabilityMatchCheck = True

End If

End Function

Function DISMatchCheck() As Boolean

Dim lastRow As Interior

Dim ws As Worksheet

Set ws = [Link]("LS")

If [Link]([Link], "C").End(xlUp).Row <> [Link]([Link], "D").End(xlUp).Row Then

DISMatchCheck = False

Else

DISMatchCheck = True

End If

End Function

Module 3 code

Sub GenerateRUNFiles()

Call GenerateINT_RUNFile

Call GenerateDMG_RUNFiles

MsgBox "Condition Run Files generated Successfully"

End Sub

Sub GenerateINT_RUNFile()

Dim ws As Worksheet
 Dim cmdFilePath As String

Dim cmdFileNumber As Integer

Dim wsCurrent As Worksheet

Dim savingformat As String

savingformat = [Link]("GEN").Range("C13").value

Set wsCurrent = [Link]

cmdFilePath = [Link] & "\" & [Link]("C3").value & "- INTACT [Link]"

cmdFileNumber = FreeFile

Open cmdFilePath For Output As #cmdFileNumber

Print #cmdFileNumber, "CLEAR REPORT"

Print #cmdFileNumber, "READ " & [Link]("C5").value

Print #cmdFileNumber, ""

Print #cmdFileNumber, "DELETE ALL WEIGHTS"

Print #cmdFileNumber, "\{BOLD}{LEFT} Condition #:" & [Link]("C3").value

Print #cmdFileNumber, "\{BOLD}{LEFT} INTACT CASE"

Print #cmdFileNumber, ""

Print #cmdFileNumber, "LBP " & Longi_Position([Link]("C7").value) & " to " &
Longi_Position([Link]("C9").value)

Print #cmdFileNumber, ""

Print #cmdFileNumber, LightShipWeight()

'Fixed Weight

Dim rng As Range

Dim sheet As Worksheet

Set sheet = [Link]("F_WT")

Set rng = [Link]("A2:F1048576")

Set rng = [Link]("A2:F" & [Link]([Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'Fixed Weights"

For f_wt = 1 To [Link]

Print #cmdFileNumber, FixedWeight([Link](f_wt))

Next f_wt

End If

'Distributed Fixed Weights

Dim no As Integer

If [Link]("C11").value = Empty Then

no = 0

Else

no = [Link]("C11").value

End If

If no > 0 Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'Distributed Fixed Weights"

For i = 1 To no

Print #cmdFileNumber, FixedWeight_Dis([Link]("F_WT_DIS" & i))

Next i

End If

'Tanks

Dim sheetTK As Worksheet

Set sheetTK = [Link]("TK")

Dim rng_TK As Range

Set rng_TK = [Link]("A2:H" & [Link]([Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'Tanks"

For tk = 1 To rng_TK.[Link]

Print #cmdFileNumber, tank(rng_TK.Rows(tk))

Print #cmdFileNumber, FSM(rng_TK.Rows(tk))

Print #cmdFileNumber, ""

Next tk

End If

' Flood Points

Dim sheetFP As Worksheet

Set sheetFP = [Link]("FLD")

Dim rng_FP As Range

Set rng_FP = [Link]("A2:F1048576")

Set rng_FP = [Link]("A2:E" & [Link](rng_FP.[Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'Flood Points"

For fp = 1 To rng_FP.[Link]

Print #cmdFileNumber, FloodPoint(rng_FP.Rows(fp), fp)

Next fp

End If

' Critical Points

Dim sheetCP As Worksheet

 Set sheetCP = [Link]("CRT")

Dim rng_CP As Range

Set rng_CP = [Link]("A2:F1048576")

Set rng_CP = [Link]("A2:E" & [Link](rng_CP.[Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'Critical Points"

For cp = 1 To rng_CP.[Link]

Print #cmdFileNumber, CriticalPoint(rng_CP.Rows(cp), cp, Empty)

Next cp

End If

'Intact Criteria

Dim sheetINTCRI As Worksheet

Set sheetINTCRI = [Link]("INT_CRI")

Set rng_INTCRI = [Link]("C2:D1048576")

Set rng_INTCRI = [Link]("C2:D" & [Link](rng_INTCRI.[Link],

"C").End(xlUp).Row)

If IsEmpty([Link]("C2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'set the area limit"

Print #cmdFileNumber, "Limit Title " & [Link]("A2").value

For intcri = 1 To rng_INTCRI.[Link]

Print #cmdFileNumber, Criteria(rng_INTCRI.Rows(intcri), intcri)

Next intcri

End If

'Solve Setting
 Dim sheetINTSLVSET As Worksheet

Set sheetINTSLVSET = [Link]("INT_SLV_SET")

Set rng_INTslvset = [Link]("A2:B1048576")

Set rng_INTslvset = [Link]("A2:B" & [Link](rng_INTslvset.[Link],

"A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For intslvset = 1 To rng_INTslvset.[Link]

Print #cmdFileNumber, SolveSetting(rng_INTslvset.Rows(intslvset))

Next intslvset

End If

'Wind Criteria

Dim sheetINT_WDCRI As Worksheet

Set sheetINT_WDCRI = [Link]("INT_WD_CRI")

Set rng_INT_WDCRI = sheetINT_WDCRI.Range("C2:D1048576")

Set rng_INT_WDCRI = sheetINT_WDCRI.Range("C2:D" &

sheetINT_WDCRI.Cells(rng_INT_WDCRI.[Link], "C").End(xlUp).Row)

If IsEmpty(sheetINT_WDCRI.Range("C2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "limit off"

Print #cmdFileNumber, "roll imo"

Print #cmdFileNumber, "roll ?"

Print #cmdFileNumber, "wind (pressure) " & sheetINT_WDCRI.Range("A5").value

If IsEmpty(sheetINT_WDCRI.Range("A8").value) Then

Print #cmdFileNumber, "hmmt wind /const"

Else

Print #cmdFileNumber, "hmmt wind /const/gust:" & sheetINT_WDCRI.Range("A8").value

 End If

Print #cmdFileNumber, ""

Print #cmdFileNumber, "solve"

Print #cmdFileNumber, "hmmt report"

Print #cmdFileNumber, ""

Print #cmdFileNumber, "Limit Title " & sheetINT_WDCRI.Range("A2").value

For int_wdcri = 1 To rng_INT_WDCRI.[Link]

Print #cmdFileNumber, Criteria(rng_INT_WDCRI.Rows(int_wdcri), int_wdcri)

Next int_wdcri

End If

'Wind Solve Setting

Dim sheetINT_WDSLVSET As Worksheet

Set sheetINT_WDSLVSET = [Link]("INT_WD_SLV_SET")

Set rng_INT_WDslvset = sheetINT_WDSLVSET.Range("A2:B1048576")

Set rng_INT_WDslvset = sheetINT_WDSLVSET.Range("A2:B" &

sheetINT_WDSLVSET.Cells(rng_INT_WDslvset.[Link], "A").End(xlUp).Row)

If IsEmpty(sheetINT_WDSLVSET.Range("A2").value) = False Then

For int_wdslvset = 1 To rng_INT_WDslvset.[Link]

Print #cmdFileNumber, ""

Print #cmdFileNumber, SolveSetting(rng_INT_WDslvset.Rows(int_wdslvset))

Next int_wdslvset

End If

' ======= STRENGTH BLOCK (only when LS_DIS has data) =======

If HasLSDISData() Then

Dim cBlock As String, lBlock As String, dBlock As String

cBlock = ContentsBlock() ' builds "DELETE ALL WEIGHTS" + CONTENTS lines

If Len(cBlock) > 0 Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, cBlock

End If

' two zero lines, exactly as in your example

Print #cmdFileNumber, "0"

Print #cmdFileNumber, "0"

lBlock = LoadBlock() ' builds grouped LOAD lines by TK!G

If Len(lBlock) > 0 Then Print #cmdFileNumber, lBlock

' two zero lines before distribution

Print #cmdFileNumber, "0"

Print #cmdFileNumber, "0"

dBlock = LS_DISBlock() ' prints:

' WEIGHT

' w@loc

' w@loc

' ...

If Len(dBlock) > 0 Then Print #cmdFileNumber, dBlock

' trailing zeros and Solve (to match your sample)

Print #cmdFileNumber, "0"

Print #cmdFileNumber, "Solve"

End If

' ======= END STRENGTH BLOCK =======

' ===== LS LIMITS (print only if any C:J exists) + BHD (always) =====

Dim wsLMT As Worksheet, lastRowLMT As Long, r As Long

Set wsLMT = [Link]("LS_LMT")

lastRowLMT = [Link]([Link], "A").End(xlUp).Row

'--- Limits: only if any row has values in C:J ---

If HasAnyLSLimits(wsLMT, 3) Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'to set the limit for bending moment and shear force"

Print #cmdFileNumber, "Llimit /off"

Print #cmdFileNumber, ""

For r = 3 To lastRowLMT

If RowHasAnyLSLimitValues(wsLMT, r) Then

'Use your existing LSLimit() to format from columns B..J (note in K)

Print #cmdFileNumber, LSLimit([Link](r))

End If

Next r

End If

'--- BHD: always print when A/B present on a row ---

If lastRowLMT >= 3 Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'to set the BHD"

For r = 3 To lastRowLMT

If Not IsEmpty([Link](r, "A").value) Or Not IsEmpty([Link](r, "B").value) Then

Print #cmdFileNumber, "BHD " & """" & [Link](r, "A").value & """" & " " &
Longi_Position([Link](r, "B").value)

End If
 Next r

End If

'LS Solve Setting

Dim sheetLS_SLVSET As Worksheet

Set sheetLS_SLVSET = [Link]("LS_SLV_SET")

Set rng_LS_slvset = sheetLS_SLVSET.Range("A2:B1048576")

Set rng_LS_slvset = sheetLS_SLVSET.Range("A2:B" & sheetLS_SLVSET.Cells(rng_LS_slvset.[Link],

"A").End(xlUp).Row)

If IsEmpty(sheetLS_SLVSET.Range("A2").value) = False Then

Print #cmdFileNumber, ""

For ls_slvset = 1 To rng_LS_slvset.[Link]

Print #cmdFileNumber, SolveSetting(rng_LS_slvset.Rows(ls_slvset))

Next ls_slvset

End If

Print #cmdFileNumber, ""

Print #cmdFileNumber, "REPORT SAVE " & [Link] & "\" & [Link]("C3").value &
"- INTACT CASE." & savingformat

Print #cmdFileNumber, "/"

Close #cmdFileNumber

End Sub

Sub GenerateDMG_RUNFiles()

Dim rng_Dmg As Range

Dim rng_Com As Range

Dim lastRow As Long

Dim lastRow_Com As Long

Dim ws_Dmg As Worksheet

Dim ws_Com As Worksheet

Dim savingformat As String

 savingformat = [Link]("GEN").Range("C13").value

Set ws_Dmg = [Link]("DMG")

Set ws_Com = [Link]("COM")

lastRow_Dmg = ws_Dmg.Cells(ws_Dmg.[Link], "A").End(xlUp).Row

lastRow_Com = ws_Com.Cells(ws_Com.[Link], "A").End(xlUp).Row

Set rng_Dmg = ws_Dmg.Range("A2:B" & lastRow_Dmg)

Set rng_Com = ws_Com.Range("A2:B" & lastRow_Com)

Call CreateDirectoryIfNotExists([Link] & "\Damage Cases")

CopyGF

Dim cmdFilePath As String

Dim cmdFileNumber As Integer

Dim wsCurrent As Worksheet

Set wsCurrent = [Link]

Dim damageCombined As Integer

Dim damageCombinedFilepath As String

damageCombinedFilepath = [Link] & "\" & [Link]("C3").value & "- DAMAGE

[Link]"

damageCombined = FreeFile

Open damageCombinedFilepath For Output As #damageCombined

For d = 1 To lastRow_Dmg - 1

Dim caseno As Integer

Dim damagedstring As String

Dim part As Variant

Dim damageParts() As String ' Array to hold split parts

 caseno = rng_Dmg.Cells(d, 1).value

damagedstring = rng_Dmg.Cells(d, 2).value

' Split the damagedstring using comma as a delimiter

damageParts = Split(damagedstring, ",")

cmdFilePath = [Link] & "\Damage Cases\" & [Link]("C3").value & "-

DAMAGE CASE " & caseno & ".RUN"

cmdFileNumber = FreeFile

Open cmdFilePath For Output As #cmdFileNumber

Print #cmdFileNumber, "CLEAR REPORT"

Print #cmdFileNumber, "READ " & [Link]("C5").value

Print #cmdFileNumber, ""

'Permeability

For j = LBound(damageParts) To UBound(damageParts)

part = damageParts(j)

Print #cmdFileNumber, Permeability(part, rng_Com)

Next j

Print #cmdFileNumber, ""

Print #cmdFileNumber, "DELETE ALL WEIGHTS"

Print #cmdFileNumber, "\{BOLD}{LEFT} Condition #:" & [Link]("C3").value

Print #cmdFileNumber, "\{BOLD}{LEFT} DAMAGE CASE " & caseno

Print #cmdFileNumber, ""

 Print #cmdFileNumber, "LBP " & Longi_Position([Link]("C7").value) & " to " &
Longi_Position([Link]("C9").value)

Print #cmdFileNumber, ""

Print #cmdFileNumber, LightShipWeight()

'Fixed Weight

Dim rng As Range

Dim sheet As Worksheet

Set sheet = [Link]("F_WT")

Set rng = [Link]("A2:F1048576")

Set rng = [Link]("A2:F" & [Link]([Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For f_wt = 1 To [Link]

Print #cmdFileNumber, FixedWeight([Link](f_wt))

Next f_wt

End If

'Distributed Fixed Weights

Dim no As Integer

If [Link]("C11").value = Empty Then

no = 0

Else

no = [Link]("C11").value

End If

If no > 0 Then

Print #cmdFileNumber, ""

For i = 1 To no
 Print #cmdFileNumber, FixedWeight_Dis([Link]("F_WT_DIS" & i))

Next i

End If

'Tanks

Dim sheetTK As Worksheet

Set sheetTK = [Link]("TK")

Dim rng_TK As Range

Set rng_TK = [Link]("A2:H" & [Link]([Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For tk = 1 To rng_TK.[Link]

Print #cmdFileNumber, tank(rng_TK.Rows(tk))

Print #cmdFileNumber, FSM(rng_TK.Rows(tk))

Print #cmdFileNumber, ""

Next tk

End If

' Flood Points

Dim sheetFP As Worksheet

Set sheetFP = [Link]("FLD")

Dim rng_FP As Range

Set rng_FP = [Link]("A2:F1048576")

Set rng_FP = [Link]("A2:E" & [Link](rng_FP.[Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For fp = 1 To rng_FP.[Link]

Print #cmdFileNumber, FloodPoint(rng_FP.Rows(fp), fp)

 Next fp

End If

' Critical Points

Dim sheetCP As Worksheet

Set sheetCP = [Link]("CRT")

Dim rng_CP As Range

Set rng_CP = [Link]("A2:F1048576")

Set rng_CP = [Link]("A2:E" & [Link](rng_CP.[Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For cp = 1 To rng_CP.[Link]

Print #cmdFileNumber, CriticalPoint(rng_CP.Rows(cp), cp, damagedstring)

Next cp

End If

'Damage Case Definision

Print #cmdFileNumber, ""

Print #cmdFileNumber, "Case " & caseno

For j = LBound(damageParts) To UBound(damageParts)

part = damageParts(j)

Print #cmdFileNumber, "TYPE (" & part & ") FLOODED"

Next j

'Damage Criteria

Dim sheetDMGCRI As Worksheet

Set sheetDMGCRI = [Link]("DMG_CRI")

Set rng_DMGCRI = [Link]("C2:D1048576")

 Set rng_DMGCRI = [Link]("C2:D" & [Link](rng_DMGCRI.[Link],
"C").End(xlUp).Row)

If IsEmpty([Link]("C2").value) = False Then

Print #cmdFileNumber, ""

Print #cmdFileNumber, "'set the area limit"

Print #cmdFileNumber, "Limit Title " & [Link]("A2").value

For dmgcri = 1 To rng_DMGCRI.[Link]

Print #cmdFileNumber, Criteria(rng_DMGCRI.Rows(dmgcri), dmgcri)

Next dmgcri

End If

'Solve Setting

Dim sheetDMGSLVSET As Worksheet

Set sheetDMGSLVSET = [Link]("DMG_SLV_SET")

Set rng_DMGslvset = [Link]("A2:B1048576")

Set rng_DMGslvset = [Link]("A2:B" &

[Link](rng_DMGslvset.[Link], "A").End(xlUp).Row)

If IsEmpty([Link]("A2").value) = False Then

Print #cmdFileNumber, ""

For dmgslvset = 1 To rng_DMGslvset.[Link]

Print #cmdFileNumber, SolveSetting(rng_DMGslvset.Rows(dmgslvset))

Next dmgslvset

End If

'Save

Print #cmdFileNumber, ""

Print #cmdFileNumber, "REPORT SAVE " & [Link] & "\Damage Cases\" &
[Link]("C3").value & "- DAMAGE CASE " & caseno & "." & savingformat

Print #cmdFileNumber, "/"

 Print #damageCombined, "RUN " & cmdFilePath & vbCrLf

Close #cmdFileNumber

Next d

Print #damageCombined, "/"

Close #damageCombined

End Sub

Sub SaveDamageCases()

Dim rng_Dmg As Range

Dim lastRow As Long

Dim ws_Dmg As Worksheet

Set ws_Dmg = [Link]("DMG")

lastRow_Dmg = ws_Dmg.Cells(ws_Dmg.[Link], "A").End(xlUp).Row

Set rng_Dmg = ws_Dmg.Range("A2:B" & lastRow_Dmg)

Dim cmdFilePath As String

Dim cmdFileNumber As Integer

Dim wsCurrent As Worksheet

Set wsCurrent = [Link]

cmdFilePath = [Link] & "\Damage [Link]"

cmdFileNumber = FreeFile

Open cmdFilePath For Output As #cmdFileNumber

For d = 1 To lastRow_Dmg - 1

Dim caseno As Integer

Dim damagedstring As String

 Dim part As Variant

Dim damageParts() As String ' Array to hold split parts

caseno = rng_Dmg.Cells(d, 1).value

damagedstring = rng_Dmg.Cells(d, 2).value

Print #cmdFileNumber, caseno & "-" & damagedstring

Next d

Close #cmdFileNumber

End Sub

Function Longi_Position(value As Double) As String

If value < 0 Then

Longi_Position = Abs(value) & "a"

Else

Longi_Position = Abs(value) & "f"

End If

End Function

Function Trans_Position(value As Double) As String

If value < 0 Then

Trans_Position = Abs(value) & "p"

Else

Trans_Position = Abs(value) & "s"

End If

End Function

Function Verti_Position(value As Double) As String

If value < 0 Then

Verti_Position = Abs(value) & "l"

Else

Verti_Position = Abs(value) & "u"

End If
End Function

Function LightShipWeight() As String

Dim wsLS As Worksheet

Set wsLS = [Link]("LS")

If Not IsEmpty([Link]("C2").value) Then

LightShipWeight = LSWeight()

Else

LightShipWeight = ""

End If

End Function

Function LSWeight() As String

Dim sheet As Worksheet

Set sheet = [Link]("LS")

LSWeight = "WEIGHT" & " " & [Link]("C2").value & " " &
Longi_Position([Link]("D2").value) & " " & Trans_Position([Link]("E2").value) & " " &
Verti_Position([Link]("F2").value)

End Function

Function LS_DISWeight() As String

Dim sheet As Worksheet

Set sheet = [Link]("LS")

Dim rng As Range

Set rng = [Link]("C2:D" & [Link]([Link], "C").End(xlUp).Row)

LS_DISWeight = "WEIGHT" & " " & LS_DIS(rng) & " " & Trans_Position([Link]("E2").value) & " " &
Verti_Position([Link]("F2").value)

End Function

Function LS_DIS(rng As Range) As String

For i = 1 To [Link]

LS_DIS = LS_DIS & " " & [Link](i, 1).value & "@" & Longi_Position([Link](i, 2).value)

Next i
End Function

Function FixedWeight(rng As Range) As String

If IsEmpty([Link](1, 6).value) = True Then

FixedWeight = "Add" & " " & """" & [Link](1, 1).value & """" & " " & [Link](1, 2).value & " " &
Longi_Position([Link](1, 3).value) & " " & Trans_Position([Link](1, 4).value) & " " &
Verti_Position([Link](1, 5).value)

Else

FixedWeight = vbCrLf & "'" & [Link](1, 6).value & vbCrLf & "Add" & " " & """" & [Link](1,
1).value & """" & " " & [Link](1, 2).value & " " & Longi_Position([Link](1, 3).value) & " " &
Trans_Position([Link](1, 4).value) & " " & Verti_Position([Link](1, 5).value)

End If

End Function

Function FixedWeight_Dis(sheet As Worksheet) As String

Dim rng As Range

Set rng = [Link]("C2:D" & [Link]([Link], "C").End(xlUp).Row)

If IsEmpty([Link]("A5").value) = True Then

FixedWeight_Dis = "Add" & " " & """" & [Link]("A2").value & """" & " " & FW_DIS(rng,
[Link]("E2").value, [Link]("F2").value)

Else

FixedWeight_Dis = vbCrLf & "'" & [Link]("A5").value & vbCrLf & "Add" & " " & """" &
[Link]("A2").value & """" & " " & FW_DIS(rng, [Link]("E2").value, [Link]("F2").value)

End If

End Function

Function FW_DIS(rng As Range, tcgval As Variant, vcgval As Variant) As String

For i = 1 To [Link]

FW_DIS = FW_DIS & " " & [Link](i, 1).value & "@" & Longi_Position([Link](i, 2).value) & "@" &
Trans_Position(CLng(tcgval)) & "@" & Verti_Position(CLng(vcgval))

Next i

End Function

Function tank(rng As Range) As String

 Dim stringload As String

If IsEmpty([Link](1, 2).value) = False Then

stringload = CStr(CLng([Link](1, 2).value) / 100)

End If

If IsEmpty([Link](1, 3).value) = False Then

stringload = "Weight:" & [Link](1, 3).value

End If

If IsEmpty([Link](1, 4).value) = False Then

stringload = "Volume:" & [Link](1, 4).value

End If

If IsEmpty([Link](1, 6).value) = True Then

tank = "Load (" & [Link](1, 1).value & ") " & stringload

Else

tank = vbCrLf & "'" & [Link](1, 6).value & vbCrLf & "Load (" & [Link](1, 1).value & ") " &
stringload

End If

End Function

Function FSM(rng As Range) As String

Dim stringload As String

If IsEmpty([Link](1, 5).value) = False Then

stringload = UCase([Link](1, 5).value)

Else

stringload = ""

End If

FSM = "FSM (" & [Link](1, 1).value & ") " & stringload

End Function

Function FloodPoint(rng As Range, no As Variant) As String

If IsEmpty([Link](1, 6).value) = True Then

 FloodPoint = "Fldpt (" & no & ")" & " " & """" & [Link](1, 1).value & """" & " " &
Longi_Position([Link](1, 3).value) & " " & Trans_Position([Link](1, 4).value) & " " &
Verti_Position([Link](1, 5).value)

Else

FloodPoint = vbCrLf & "'" & [Link](1, 6).value & vbCrLf & "Fldpt (" & no & ")" & " " & """" &
[Link](1, 1).value & """" & " " & Longi_Position([Link](1, 3).value) & " " & Trans_Position([Link](1,
4).value) & " " & Verti_Position([Link](1, 5).value)

End If

End Function

Function CriticalPoint(rng As Range, no As Variant, damagedstring As String) As String

Dim outputstring As String

If IsEmpty(damagedstring) = False Then

If MatchCheck([Link](1, 2), damagedstring) Then

outputstring = "'"

Else

outputstring = ""

End If

End If

If IsEmpty([Link](1, 6).value) = True Then

CriticalPoint = outputstring & "CrtPt (" & no & ")" & " " & """" & [Link](1, 1).value & """" & " " &
Longi_Position([Link](1, 3).value) & " " & Trans_Position([Link](1, 4).value) & " " &
Verti_Position([Link](1, 5).value)

Else

CriticalPoint = vbCrLf & "'" & [Link](1, 6).value & vbCrLf & outputstring & "CrtPt (" & no & ")" & " "
& """" & [Link](1, 1).value & """" & " " & Longi_Position([Link](1, 3).value) & " " &
Trans_Position([Link](1, 4).value) & " " & Verti_Position([Link](1, 5).value)

End If

End Function

Function MatchCheck(val As Variant, vals As String) As Boolean

MatchCheck = False
 Dim valssplited() As String

valssplited = Split(vals, ",")

For i = LBound(valssplited) To UBound(valssplited)

If valssplited(i) = val Then

MatchCheck = True

Exit For

End If

Next i

End Function

Function Criteria(rng As Range, no As Variant) As String

If IsEmpty([Link](1, 2).value) = True Then

Criteria = "Limit (" & no & ")" & " " & [Link](1, 1).value

Else

Criteria = vbCrLf & "'" & [Link](1, 2).value & vbCrLf & "Limit (" & no & ")" & " " & [Link](1,
1).value

End If

End Function

Function SolveSetting(rng As Range) As String

If IsEmpty([Link](1, 2).value) = True Then

SolveSetting = [Link](1, 1).value

Else

SolveSetting = vbCrLf & "'" & [Link](1, 2).value & vbCrLf & [Link](1, 1).value

End If

End Function

Function LSLimit(rng As Range) As String

If IsEmpty([Link](1, 11).value) = True Then

LSLimit = "Llimit loc:" & Longi_Position([Link](1, 2).value) & ", " & [Link](1, 3).value & ", " &
[Link](1, 4).value & ", " & [Link](1, 5).value & ", " & [Link](1, 6).value & ", " & [Link](1, 7).value
& ", " & [Link](1, 8).value & ", " & [Link](1, 9).value & ", " & [Link](1, 10).value
 Else

LSLimit = vbCrLf & "'" & [Link](1, 11).value & vbCrLf & "Llimit loc:" & Longi_Position([Link](1,
2).value) & ", " & [Link](1, 3).value & ", " & [Link](1, 4).value & ", " & [Link](1, 5).value & ", " &
[Link](1, 6).value & ", " & [Link](1, 7).value & ", " & [Link](1, 8).value & ", " & [Link](1, 9).value
& ", " & [Link](1, 10).value

End If

End Function

Function LS_BHD(rng As Range) As String

If IsEmpty([Link](1, 11).value) = True Then

LS_BHD = "BHD" & " " & """" & [Link](1, 1).value & """" & " " & Longi_Position([Link](1,
2).value)

Else

LS_BHD = vbCrLf & "'" & [Link](1, 11).value & vbCrLf & "BHD" & " " & """" & [Link](1, 1).value &
"""" & " " & Longi_Position([Link](1, 2).value)

End If

End Function

Sub CreateDirectoryIfNotExists(folderPath As String)

On Error Resume Next ' Ignore errors temporarily

MkDir folderPath ' Attempt to create the directory

If [Link] <> 0 Then

If [Link] <> 75 Then

MsgBox "An error occurred: " & [Link]

End If

End If

On Error GoTo 0 ' Reset error handling

End Sub

Function Permeability(val As Variant, rng As Range) As Variant

Permeability = ""

For i = 1 To [Link]
 If [Link](i, 1).value = val Then

Permeability = "PERM (" & val & ") " & [Link](i, 2).value

Exit For

End If

Next i

End Function

Sub CopyGF()

Dim sourceFilePath As String

Dim destFilePath As String

destFilePath = [Link] & "\Damage Cases\" &

[Link]("GEN").Range("C5").value

If Dir(destFilePath) = "" Then

Dim fd1 As FileDialog

Dim fileChosen1 As Integer

Dim basename1 As String

Dim fso1 As Variant

Set fso1 = CreateObject("[Link]")

Set fd1 = [Link](msoFileDialogFilePicker)

basename1 = [Link]([Link])

[Link] = "Select Geometry File"

[Link] = [Link] & "\" & [Link]("GEN").Range("C5").value

' Set Default Location to the Active Workbook Path

[Link] = msoFileDialogViewList

[Link] = False

[Link]

[Link] "Geometry File", "*.GF"

fileChosen1 = [Link]

If [Link] > 0 Then

 sourceFilePath = [Link](1)

FileCopy sourceFilePath, destFilePath

End If

End If

End Sub

' ---------- LS Distribution print block ----------

Function LS_DISBlock() As String

Dim ws As Worksheet, lastRow As Long, i As Long

Dim buf As String, anyData As Boolean

On Error Resume Next

Set ws = [Link]("LS_DIS")

On Error GoTo 0

If ws Is Nothing Then Exit Function

lastRow = [Link]([Link], "A").End(xlUp).Row

If lastRow < 2 Then Exit Function

For i = 2 To lastRow

If Len(Trim$(CStr([Link](i, "A").value))) > 0 Or Len(Trim$(CStr([Link](i, "B").value))) > 0 Then

If Not anyData Then buf = "WEIGHT" & vbCrLf: anyData = True

buf = buf & [Link](i, "A").value & "@" & Longi_Position([Link](i, "B").value) & vbCrLf

End If

Next i

If anyData Then

If Right$(buf, 2) = vbCrLf Then buf = Left$(buf, Len(buf) - 2)

LS_DISBlock = buf

End If
End Function

Function HasLSDISData() As Boolean

Dim ws As Worksheet, lastRow As Long, i As Long

On Error Resume Next

Set ws = [Link]("LS_DIS")

On Error GoTo 0

If ws Is Nothing Then Exit Function

lastRow = [Link]([Link], "A").End(xlUp).Row

If lastRow < 2 Then Exit Function

For i = 2 To lastRow

If Len(Trim$(CStr([Link](i, "A").value))) > 0 Or Len(Trim$(CStr([Link](i, "B").value))) > 0 Then

HasLSDISData = True: Exit Function

End If

Next i

End Function

Function ContentsBlock() As String

Dim ws As Worksheet, lastRow As Long, i As Long

Dim tank As String, label As String, sgText As String

Dim buf As String, anyData As Boolean

On Error Resume Next

Set ws = [Link]("TK")

On Error GoTo 0

If ws Is Nothing Then Exit Function

lastRow = [Link]([Link], "A").End(xlUp).Row

If lastRow < 2 Then Exit Function

 For i = 2 To lastRow

tank = Trim$(CStr([Link](i, "A").value)) ' tank name

label = Trim$(CStr([Link](i, "G").value)) ' CONTENT label

sgText = Trim$(CStr([Link](i, "H").value)) ' SG

' Require: tank name present, label present, SG present and numeric

If Len(tank) > 0 And Len(label) > 0 And Len(sgText) > 0 And IsNumeric(sgText) Then

If Not anyData Then

buf = "DELETE ALL WEIGHTS" & vbCrLf

anyData = True

End If

buf = buf & "CONTENTS (" & tank & ")=""" & label & """ " & sgText & vbCrLf

End If

Next i

If anyData Then

' trim trailing CRLF

If Right$(buf, 2) = vbCrLf Then buf = Left$(buf, Len(buf) - 2)

ContentsBlock = buf

End If

End Function

' ---------- Strength: grouped LOAD by TK!G ----------

Function LoadBlock() As String

Dim ws As Worksheet, lastRow As Long, i As Long

Dim tank As String, loadTxt As String, grp As String, prevGrp As String, buf As String

Set ws = [Link]("TK")

lastRow = [Link]([Link], "A").End(xlUp).Row

 If lastRow < 2 Then Exit Function

For i = 2 To lastRow

tank = Trim$(CStr([Link](i, "A").value))

If Len(tank) = 0 Then GoTo nxt

grp = Trim$(CStr([Link](i, "G").value))

If Len(grp) > 0 And grp <> prevGrp Then

buf = buf & "`" & grp & vbCrLf

prevGrp = grp

End If

loadTxt = ""

If Len(Trim$(CStr([Link](i, "B").value))) > 0 Then loadTxt = CStr(CLng([Link](i, "B").value) / 100)

If Len(Trim$(CStr([Link](i, "C").value))) > 0 Then loadTxt = "WEIGHT: " & Trim$(CStr([Link](i,

"C").value))

If Len(Trim$(CStr([Link](i, "D").value))) > 0 Then loadTxt = "VOLUME: " & Trim$(CStr([Link](i,

"D").value))

If Len(loadTxt) = 0 Then loadTxt = "0"

buf = buf & "LOAD (" & tank & ") " & loadTxt & vbCrLf

nxt:

Next i

If Len(buf) > 0 Then LoadBlock = Left$(buf, Len(buf) - 2)

End Function

'Return True if row r on LS_LMT has any limit value in cols C:J

Private Function RowHasAnyLSLimitValues(ws As Worksheet, r As Long) As Boolean

 RowHasAnyLSLimitValues = [Link]([Link]("C" & r & ":J" & r)) > 0

End Function

'Return True if the LS_LMT sheet has at least one row (from firstDataRow) with any limit in C:J

Private Function HasAnyLSLimits(ws As Worksheet, firstDataRow As Long) As Boolean

Dim lastRow As Long, r As Long

lastRow = [Link]([Link], "A").End(xlUp).Row

For r = firstDataRow To lastRow

If RowHasAnyLSLimitValues(ws, r) Then

HasAnyLSLimits = True

Exit Function

End If

Next r

End Function