Intersect Failing

S

sassriverrat

Well-known Member
Joined
Oct 4, 2018
Messages
655
Happy Thanksgiving All,

I have a macro that creates a sheet (below). Now that everything else is working, it seems to be failing when making the the sheet. Error is a "Global_Object failed and it's highlighting the "If Not Intersect(Target, Range("R5,W25")) Is Nothing Then" line. That first piece of code (ThisWorkbook) puts a timestamp on the sheet.


Timestamp
Code: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)If ActiveSheet.Name = "Developer" _
    Or ActiveSheet.Name = "Notes" _
    Or ActiveSheet.Name = "Ports" _
    Or ActiveSheet.Name = "Voyage Specifics" _
    Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
If Not Intersect(Target, Range("R5,W25")) Is Nothing Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
End If


If ActiveSheet.Range("Z20") = "Yes" Then
   Cells(9, 18) = "Exact"
End If


    .EnableEvents = True
    .ScreenUpdating = True


End With
End Sub

sheet creator
Code: 
Sub AddNoonSheet()'Speeds up the formating part
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False


'Adds additional Noon Sheets
    Sheets.Add(After:=Sheets("Voyage Specifics")).Name = "Noon"


'This creates all of the proper row heights/column widths
  Rows("1:55").RowHeight = 15
    Columns("A:A").ColumnWidth = 3.29
    Columns("B:B").ColumnWidth = 1.43
    Columns("C:C").ColumnWidth = 5.57
    Columns("D:D").ColumnWidth = 9.14
    Columns("E:G").ColumnWidth = 2.8
    Columns("H:H").ColumnWidth = 7.29
    Columns("I:L").ColumnWidth = 8.43
    Columns("M:M").ColumnWidth = 9.14
    Columns("N:N").ColumnWidth = 7.86
    Columns("O:O").ColumnWidth = 3.14
    Columns("P:P").ColumnWidth = 4
    Columns("Q:Q").ColumnWidth = 20
    Columns("R:R").ColumnWidth = 8.5
    Columns("S:S").ColumnWidth = 2.5
    Columns("T:T").ColumnWidth = 8
    Columns("U:U").ColumnWidth = 2
    Columns("V:V").ColumnWidth = 13
    Columns("W:W").ColumnWidth = 5
    Columns("X:X").ColumnWidth = 3
    Columns("Y:Y").ColumnWidth = 6
    Columns("Z:Z").ColumnWidth = 3.5
    
'This creates the appropriate printer border sheets and daily inputs
'Company Title
    Range("A1:O1,A20:O20,A39:O39").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Vessel Name
    Range("A2:O2,A21:O21,A40:O40").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Noon/Arrival Report
    Range("A3:O3,A22:O22,A41:O41").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Time/Date
    Range("A4:C4,A23:C23,A42:C42").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'ZD
    Range("C5,C24,C43").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'Date
    Range("F4:H4,F23:H23,F42:H42").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Port + Selected Port
    Range("I4:J4,I23:J23,I42:J42").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Selected Port
    Range("I5:J5,I24:J24,I43:J43").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Voyage #, Course, Speed, Trip Distance, Total Distance, TAS, Spd Req, Voyage Total Dist
    Range("L4:M11,L23:M30,L42:M49").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge True
'Latitude, Longitude, Hours Run, Total Hours, DTG, ETA, Wind, Wave, Swell, Temp, Pressure
    Range("A6:C16,A25:C35,A44:C54").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge True
'Latitude & Longitude Left Alignment
    Range("D6,D7,D25,D26,D44,D45").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
'ETA Date
    Range("F11:H11,F30:H30,F49:H49").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Heavy Weather
    Range("J12:L13,J31:L32,J50:L51").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Slow Steaming
    Range("J14:L15,J33:L34,J52:L53").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Watch Officer
    Range("A17:I17,A36:I36,A55:I55").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Input in Yellow
    Range("Q4:S4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'ETA Calculators
    Range("Q27:T27").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("Q29:R29,Q31:R31,Q32:R32").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("S28,S29:T29,S31:T31,S32:T32").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("P28:P29,P31:P32").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
'Voyage Report Indicators
    Range("V20:Y22").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge True
'Override Inputs and Voyage Report Indicators
    Range("Z20,Z21,Z22,V23:Z23,W24:Z24,W25:Z25,X28:Y28,X29:Y29,X30:Y30,X31:Y31,X32:Y32,X33,Y33:Z33").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("V28:W28,V29:W29,V30:W30,V31:W31,V32:W32,V34:X34").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("Y28").Select
'Borders out the Noon Report Cells
    Range("O1:O17,I12:I15,O20:O36,I31:I34,O39:O55,I50:I53").Activate
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
     Range("O1:O17,O20:O36,O39:O55").Activate
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    Range("A1:A17,A20:A36,A39:A55").Activate
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
   
    Range("A17:O17,A36:O36,A55:O55,J13:O13,J32:O32,J51:O51,J15:O15,J34:O34,J53:O53").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    
    Range("A3:O3,A22:O22,A41:O41,A5:E5,A6:E6,A24:E24,A25:E25,A43:E43,A44:E44,A45:O45,A7:O7,A26:O26,A28:O28,A30:O30,A47:O47,A9:O9,A11:O11,A49:O49,M12:O12,M31:O31,M33:O33,M14:O14,M50:O50,M52:O52").Select
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Range("E6:E7,E25:E26,E44:E45").Select
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'Borders out the Input in Yellow Cells
    Range("R5:R16,R19:R20,R23:R24,S6:S7").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
'Borders out the ETA Calculators
Range("Q27:T29,Q31:T32").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'Borders out the Voyage Report Indicators
    Range("V20:Z22").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'Borders out the Manual Input Cells
    Range("V23:Z34").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'Colors Voyage Report Indicators
    If Range("Z20") = "Yes" Then
        Interior.Color = 5287936
        ElseIf Range("Z20") = "No" Then
        Range("Z20").Interior.Color = vbRed
    End If
    If Range("Z21") = "Yes" Then
        Interior.Color = 5287936
        ElseIf Range("Z21") = "No" Then
        Range("Z21").Interior.Color = 15773696
    End If
    If Range("Z22") = "L" Then
        Interior.Color = 5287936
        ElseIf Range("Z22") = "B" Then
        Range("Z22").Interior.Color = 15773696
    End If
        
        
    
    Range("H12:H15,H31:H34,H50:H53").Borders(xlEdgeRight).LineStyle = xlNone


'Hides the Manual Inputs
    Range("V23:Z34").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("V24:Z34").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
     
'Creates Fonts for Entire Sheet
   'Font for Company
    
    Range("A1:O1,A20:O20,A39:O39").Select
    With Selection.Font
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "9"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With


   'Font for Vessel Name
    Range("A2:O2,A21:O21,A40:O40").Select
    With Selection.Font
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
   'Font for Noon/Arrival
    Range("A3:O3,A22:O22,A41:O41").Select
    With Selection.Font
        .Bold = True
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "14"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Font for Rest of the Sheet
    Range("A4:O17,A23:O36,A42:O55,P1:Z55").Select
    With Selection.Font
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With


    'Font for Input in Yellow
    Range("Q4:S4").Select
    With Selection.Font
        .Underline = xlUnderlineStyleSingle
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Font for Heavy Weather and Slow Steaming
    Range("Q18,Q22").Select
    With Selection.Font
        .Underline = xlUnderlineStyleSingle
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
   
   'Font for Rest of the Sheet
    Range("P1:Z17,P18:P55,R18:Z55,Q19:Q21,Q23:Q55").Select
    With Selection.Font
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Bold for Voyage Report Indicators and Manual Inputs
     Range("Z20:Z22,V23:Z23").Select
    With Selection.Font
        .Bold = True
        .Name = "Times New Roman"
        .Strikethrough = False
        .Size = "12"
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Aligns ETA Dates
    Range("E11,E30,E49").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("F11:H11,F30:H30,F49:H49").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    
    'Aligns Weather Reports
     Range("D12:D16,D31:D35,D50:D54").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    


    
' Inputs all of the Cell Data for the Noon Report
'


'All the formula titles
    Range("A1:O1,A20:O20,A39:O39").FormulaR1C1 = "OSG Ship Management Inc."
    Range("A2:O2,A21:O21,A40:O40").FormulaR1C1 = "=Notes!R22C11"
    Range("A3:O3,A22:O22,A41:O41").FormulaR1C1 = "Noon Report"
    Range("A4:C4,A23:C23,A42:C42").FormulaR1C1 = "Time/Date:"
    Range("E4,E23,E42").FormulaR1C1 = "/"
    Range("A5,A24,A43").FormulaR1C1 = "ZD:"
    Range("A6:C6,A25:C25,A44:C44").FormulaR1C1 = "Latitude:"
    Range("A7:C7,A26:C26,A45:C45").FormulaR1C1 = "Longitude:"
    Range("A8:C8,A27:C27,A46:C46").FormulaR1C1 = "Hours Run:"
    Range("E8,E27,E46").FormulaR1C1 = "h"
    Range("G8,G27,G46").FormulaR1C1 = "m"
    Range("A9:C9,A28:C28,A47:C47").FormulaR1C1 = "Total Hours:"
    Range("E9,E28,E47").FormulaR1C1 = "h"
    Range("G9,G28,G47").FormulaR1C1 = "m"
    Range("A10:C10,A29:C29,A48:C48").FormulaR1C1 = "DTG:"
    Range("E10,E29,E47").FormulaR1C1 = "nm"
    Range("A11:C11,A30:C30,A49:C49").FormulaR1C1 = "ETA:"
    Range("E11,E30,E49").FormulaR1C1 = "/"
    Range("A12:C12,A31:C31,A50:C50").FormulaR1C1 = "Wind:"
    Range("A13:C13,A32:C32,A51:C51").FormulaR1C1 = "Wave:"
    Range("A14:C14,A33:C33,A52:C52").FormulaR1C1 = "Swell:"
    Range("A15:C15,A34:C34,A53:C53").FormulaR1C1 = "Temp:"
    Range("A16:C16,A35:C35,A54:C54").FormulaR1C1 = "Pressure:"
    Range("A17:I17,A36:I36,A55:I55").FormulaR1C1 = "Watch Officer"
    Range("I4:J4,I23:J23,I42:J42").FormulaR1C1 = "Arrival Port:"
    Range("L4:M4,L23:M23,L42:M42").FormulaR1C1 = "Voyage:"
    Range("L5:M5,L24:M24,L43:M43").FormulaR1C1 = "Course:"
    Range("O5,O24,O44").FormulaR1C1 = "°"
    Range("L6:M6,L25:M25,L44:M44").FormulaR1C1 = "Speed:"
    Range("O6,O25,O45").FormulaR1C1 = "kts"
    Range("L7:M7,L26:M26,L45:M45").FormulaR1C1 = "Trip Distance:"
    Range("O7,O26,O46").FormulaR1C1 = "nm"
    Range("L8:M8,L27:M27,L46:M46").FormulaR1C1 = "Total Distance:"
    Range("O8,O27,O46").FormulaR1C1 = "nm"
    Range("L9:M9,L28:M28,L47:M47").FormulaR1C1 = "TAS:"
    Range("O9,O28,O47").FormulaR1C1 = "kts"
    Range("L10:M10,L29:M29,L48:M48").FormulaR1C1 = "Spd Req:"
    Range("O10,O29,O48").FormulaR1C1 = "kts"
    Range("L11:M11,L30:M30,L49:M49").FormulaR1C1 = "Voyage Tot Dist:"
    Range("O11,O30,O49").FormulaR1C1 = "nm"
    Range("J12:L13,J31:L32,J50:L51").FormulaR1C1 = "Heavy Weather:"
    Range("J14:L15,J33:L34,J52:L53").FormulaR1C1 = "Slow Steaming:"
    Range("L12:M12,L31:M31,L50:M50").FormulaR1C1 = "Time:"
    Range("O12,O31,O50").FormulaR1C1 = "hrs"
    Range("L13:M13,L32:M32,L51:M51").FormulaR1C1 = "Distance:"
    Range("O13,O32,O51").FormulaR1C1 = "nm"
    Range("L14:M14,L33:M33,L52:M52").FormulaR1C1 = "Time:"
    Range("O14,O33,O52").FormulaR1C1 = "hrs"
    Range("L15:M15,L34:M34,L53:M53").FormulaR1C1 = "Distance:"
    Range("O15,O34,O53").FormulaR1C1 = "nm"
    
    Range("Q4:S4").FormulaR1C1 = "Input in Yellow"
    Range("Q5").FormulaR1C1 = "Zone Description:"
    Range("Q6").FormulaR1C1 = "Latitude"
    Range("S6").FormulaR1C1 = "N"
    Range("Q7").FormulaR1C1 = "Longitude"
    Range("S7").FormulaR1C1 = "W"
    Range("Q8").FormulaR1C1 = "Distance to Go"
    Range("S8").FormulaR1C1 = "nm"
    Range("Q9").FormulaR1C1 = "Total Distance"
    Range("S9").FormulaR1C1 = "nm"
    Range("Q10").FormulaR1C1 = "Course:"
    Range("S10").FormulaR1C1 = "°"
    Range("Q11").FormulaR1C1 = "Wind(Dir & Force)"
    Range("Q12").FormulaR1C1 = "Wave(Dir & State):"
    Range("Q13").FormulaR1C1 = "Swell(Dir & Descr):"
    Range("Q14").FormulaR1C1 = "Temperature:"
    Range("S14").FormulaR1C1 = "°"
    Range("Q15").FormulaR1C1 = "Pressure:"
    Range("S15").FormulaR1C1 = "mb"
    Range("Q16").FormulaR1C1 = "Watch Officer:"


    Range("Q18").FormulaR1C1 = "Heavy Weather"
    Range("Q19").FormulaR1C1 = "Time:"
    Range("S19").FormulaR1C1 = "hrs"
    Range("Q20").FormulaR1C1 = "Distance:"
    Range("S20").FormulaR1C1 = "nm"
    
    Range("Q22").FormulaR1C1 = "Slow Steaming:"
    Range("Q23").FormulaR1C1 = "Time:"
    Range("S23").FormulaR1C1 = "hrs"
    Range("Q24").FormulaR1C1 = "Distance:"
    Range("S24").FormulaR1C1 = "nm"
    
    Range("P28:P29").FormulaR1C1 = "'1."
    Range("P31:P32").FormulaR1C1 = "'2."
    
    Range("Q27:T27").FormulaR1C1 = "ETA Calculators"
    Range("Q28").FormulaR1C1 = "Desired Arr Date/Time:"
    Range("S28").FormulaR1C1 = "/"
    Range("Q29:R29").FormulaR1C1 = "Mileage(If Not Today's DTG):"
    Range("Q31:R31").FormulaR1C1 = "Anticipated Average Speed:"
    Range("Q32:R32").FormulaR1C1 = "Mileage(If Not Today's DTG):"
    
    Range("V20:Y20").FormulaR1C1 = "Exact Route Calculator:"
    Range("V21:Y21").FormulaR1C1 = "Daylight Savings In Effect:"
    Range("V22:Y22").FormulaR1C1 = "Voyage Loaded/Ballast:"
    
    Range("V23:Z23").FormulaR1C1 = "Override Inputs"
    Range("V24").FormulaR1C1 = "Time:"
    Range("V25").FormulaR1C1 = "Date:"
    Range("V26").FormulaR1C1 = "Hours Run:"
    Range("X26").FormulaR1C1 = "hrs"
    Range("Z26").FormulaR1C1 = "min"
    Range("V27").FormulaR1C1 = "Total Hours:"
    Range("X27").FormulaR1C1 = "hrs"
    Range("Z27").FormulaR1C1 = "min"
    Range("V28").FormulaR1C1 = "Speed:"
    Range("Z28").FormulaR1C1 = "kts"
    Range("V29:W29").FormulaR1C1 = "Trip Distance:"
    Range("Z29").FormulaR1C1 = "nm"
    Range("V30:W30").FormulaR1C1 = "Total Distance:"
    Range("Z30").FormulaR1C1 = "nm"
    Range("V31:W31").FormulaR1C1 = "Total Average Speed:"
    Range("Z31").FormulaR1C1 = "kts"
    Range("V32").FormulaR1C1 = "Speed Required:"
    Range("Z32").FormulaR1C1 = "kts"
    Range("V33").FormulaR1C1 = "New ETA:"
    Range("X33").FormulaR1C1 = "/"
    Range("V34:W34").FormulaR1C1 = "New Voyage Distance:"
    Range("Z34").FormulaR1C1 = "nm"
    
         
    
'All of the equals for the static cells
'ZD + or -
    Range("B5").FormulaR1C1 = "=IF(R[2]C[3]=""W"",""-"",""+"")"
    Range("B24").FormulaR1C1 = "=R[-19]"
    Range("B43").FormulaR1C1 = "=R[-19]"
'12:00 Time
    Range("D4").FormulaR1C1 = "=IF(R[20]C[19]="""",TIME(12,0,0),MilitaryToTime(R[20]C[19]))"
    Range("D23").FormulaR1C1 = "=R[-19]"
    Range("D42").FormulaR1C1 = "=R[-19]"
'Date Repeater
    Range("F4:H4").FormulaR1C1 = "=IF(R[21]C[17]="""",""No Data Input"",R[21]C[17])"
    Range("F23:H23").FormulaR1C1 = "=R[-19]C"
    Range("F42:H42").FormulaR1C1 = "=R[-19]C"
'ZD = R5
    Range("C5").FormulaR1C1 = "=RC[15]"
    Range("C24").FormulaR1C1 = "=R[-19]C[15]"
    Range("C43").FormulaR1C1 = "=R[-38]C[15]"
'Latitude = R6
    Range("D6").FormulaR1C1 = "=RC[14]"
    Range("D25").FormulaR1C1 = "=R[-19]C[14]"
    Range("D44").FormulaR1C1 = "=R[-38]C[14]"
'N or S
    Range("E6").FormulaR1C1 = "=RC[14]"
    Range("E25").FormulaR1C1 = "=R[-19]C"
    Range("E44").FormulaR1C1 = "=R[-19]C"
'Longtitude = R7
    Range("D7").FormulaR1C1 = "=RC[14]"
    Range("D26").FormulaR1C1 = "=R[-19]C[14]"
    Range("D45").FormulaR1C1 = "=R[-38]C[14]"
'E or W
    Range("E7").FormulaR1C1 = "=RC[14]"
    Range("E26").FormulaR1C1 = "=R[-19]C"
    Range("E45").FormulaR1C1 = "=R[-19]C"
'Hours Run
    Range("D8").FormulaR1C1 = "=IF(R[-4]C[2]=""No Data Input"",0,IF(R[18]C[19]="""",((INT(ABS((((((R[-4]C+((IF(R[-1]C[1]=""E"",-TIME(R[-3]C[14],0,0),TIME(R[-3]C[14],0,0)))))+R[-4]C[2])-(('Voyage Specifics'!R[-2]C[-1]+((IF((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R[-5]C[-2]:R[44]C[5],8,FALSE))<0,-TIME(-((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[22]=""Yes"",-1" & _
        ",0))),0,0),TIME(((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[22]=""Yes"",-1,0))),0,0)))))+'Voyage Specifics'!R[-1]C[-1])))))))*24)+(HOUR(ABS((((((R[-4]C+((IF(R[-1]C[1]=""E"",-TIME(R[-3]C[14],0,0),TIME(R[-3]C[14],0,0)))))+R[-4]C[2])-(('Voyage Specifics'!R[-2]C[-1]+((IF((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R[-5]C[-2]:R[44]C[5]," & _
        "8,FALSE))<0,-TIME(-((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[22]=""Yes"",-1,0))),0,0),TIME(((VLOOKUP('Voyage Specifics'!R[-3]C[-1],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[22]=""Yes"",-1,0))),0,0)))))+'Voyage Specifics'!R[-1]C[-1]))))))),R[18]C[19]))" & _
        ""
    Range("D27").FormulaR1C1 = "=R[-19]C"
    Range("D46").FormulaR1C1 = "=R[-19]C"
'Min Run
    Range("F8").FormulaR1C1 = "=IF(R[-4]C=""No Data Input"",0,IF(R[18]C[19]="""",(MINUTE(ABS((((((R[-4]C[-2]+((IF(R[-1]C[-1]=""E"",-TIME(R[-3]C[12],0,0),TIME(R[-3]C[12],0,0)))))+R[-4]C)-(('Voyage Specifics'!R[-2]C[-3]+((IF((VLOOKUP('Voyage Specifics'!R[-3]C[-3],Ports!R[-5]C[-4]:R[44]C[3],8,FALSE))<0,-TIME(-((VLOOKUP('Voyage Specifics'!R[-3]C[-3],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[20]=""Yes"",-" & _
        "1,0))),0,0),TIME(((VLOOKUP('Voyage Specifics'!R[-3]C[-3],Ports!R3C2:R52C9,8,FALSE))+(IF(R[13]C[20]=""Yes"",-1,0))),0,0)))))+'Voyage Specifics'!R[-1]C[-3]))))))),R[18]C[19]))" & _
        ""
    Range("F27").FormulaR1C1 = "=R[-19]C"
    Range("F46").FormulaR1C1 = "=R[-19]C"
'Total Hours Run
    Range("D9").FormulaR1C1 = "=IF(R[18]C[19]="""",R[-1]C,R[18]C[19])"
    Range("D28").FormulaR1C1 = "=R[-19]C"
    Range("D47").FormulaR1C1 = "=R[-19]C"
'Total Min Run
    Range("F9").FormulaR1C1 = "=IF(R[18]C[19]="""",R[-1]C,R[18]C[19])"
    Range("F28").FormulaR1C1 = "=R[-19]C"
    Range("F47").FormulaR1C1 = "=R[-19]C"
'DTG =
    Range("D10").FormulaR1C1 = "=R[-2]C[14]"
    Range("D29").FormulaR1C1 = "=R[-19]"
    Range("D48").FormulaR1C1 = "=R[-19]"
'ETA = Time
    Range("D11").FormulaR1C1 = "=IF(R[22]C[19]="""",'Voyage Specifics'!R[-2]C[-1],MilitaryToTime(R[22]C[19]))"
    Range("D30").FormulaR1C1 = "=R[-19]"
    Range("D49").FormulaR1C1 = "=R[-19]"
'ETA = Date
    Range("F11:H11").FormulaR1C1 = "=IF(R[22]C[19]="""",'Voyage Specifics'!R[-1]C[-3],R[22]C[19])"
    Range("F30:H30").FormulaR1C1 = "=R[-19]"
    Range("F49:H49").FormulaR1C1 = "=R[-19]"
'Wind = R11
    Range("D12").FormulaR1C1 = "=R[-1]C[14]"
    Range("D31").FormulaR1C1 = "=R[-19]"
    Range("D50").FormulaR1C1 = "=R[-19]"
'Wave = R12
    Range("D13,D32,D51").FormulaR1C1 = "=R[-1]C[14]"
    Range("D32").FormulaR1C1 = "=R[-19]"
    Range("D51").FormulaR1C1 = "=R[-19]"
'Swell = R13
    Range("D14").FormulaR1C1 = "=R[-1]C[14]"
    Range("D33").FormulaR1C1 = "=R[-19]"
    Range("D52").FormulaR1C1 = "=R[-19]"
'Temp = R14
    Range("D15").FormulaR1C1 = "=R[-1]C[14]"
    Range("D34").FormulaR1C1 = "=R[-19]"
    Range("D53").FormulaR1C1 = "=R[-19]"
'Pressure = R15
    Range("D16").FormulaR1C1 = "=R[-1]C[14]"
    Range("D30").FormulaR1C1 = "=R[-19]"
    Range("D54").FormulaR1C1 = "=R[-19]"
'Officer
    Range("J17").FormulaR1C1 = "=R[-1]C[8]"
    Range("J36").FormulaR1C1 = "=R[-19]"
    Range("J55").FormulaR1C1 = "=R[-19]"
'Selected Arrival
    Range("I5:J5").FormulaR1C1 = "=IF('Voyage Specifics'!R[3]C[-6]="""",""No Port Selected"",'Voyage Specifics'!R[3]C[-6])"
    Range("I24:J24").FormulaR1C1 = "=R[-19]"
    Range("I43:J43").FormulaR1C1 = "=R[-19]"
'Voyage #
    Range("N4").FormulaR1C1 = "='Voyage Specifics'!RC[-11]"
    Range("N23").FormulaR1C1 = "=R[-19]"
    Range("N42").FormulaR1C1 = "=R[-19]"
'Course
    Range("N5").FormulaR1C1 = "=R[5]C[4]"
    Range("N24").FormulaR1C1 = "=R[-19]"
    Range("N43").FormulaR1C1 = "=R[-19]"
'Speed
    Range("N6").FormulaR1C1 = "=IF((R[22]C[9]=""""),(R[1]C[0]/(R[2]C[-10]+(R[1]C[-8]/60))),R[22]C[9])"
    Range("N25").FormulaR1C1 = "=R[-19]"
    Range("N44").FormulaR1C1 = "=R[-19]"
'Trip Distance
    Range("N7").FormulaR1C1 = "=IF(R[22]C[10]="""",R[1]C[0],R[22]C[10])"
    Range("N26").FormulaR1C1 = "=R[-19]"
    Range("N45").FormulaR1C1 = "=R[-19]"
'Total Distance
    Range("N8").FormulaR1C1 = "=IF(R[22]C[10]="""",IF(R[12]C[12]=""Yes"",R[3]C-R[2]C[-10],R[1]C[4]+'Voyage Specifics'!R[4]C[-11]),R[22]C[10])"
    Range("N27").FormulaR1C1 = "=R[-19]"
    Range("N46").FormulaR1C1 = "=R[-19]"
'TAS
    Range("N9").FormulaR1C1 = "=IF(R[22]C[11]="""",(R[-1]C/(RC[-10]+(RC[-8]/60))),R[22]C[11])"
    Range("N28").FormulaR1C1 = "=R[-19]"
    Range("N47").FormulaR1C1 = "=R[-19]"
'Spd Req
    Range("N10").FormulaR1C1 = "=IF(R[22]C[10]="""",(RC[-10]/(((R[1]C[-8]+R[1]C[-10]+(TIME(IF(R[11]C[12]=""Yes"",(VLOOKUP(R[-5]C[-5],Ports!R[-7]C[-12]:R[42]C[-4],8,FALSE))-1,(VLOOKUP(R[-5]C[-5],Ports!R[-7]C[-12]:R[42]C[-4],8,FALSE))),0,0)))-(R[-6]C[-8]+R[-6]C[-10]+(TIME(R[-5]C[-11],0,0))))*24)),R[22]C[10])"
    Range("N29").FormulaR1C1 = "=R[-19]"
    Range("N48").FormulaR1C1 = "=R[-19]"
'Voyage Tot Dist
    Range("N11").FormulaR1C1 = "=(IF(R[23]C[11]<>"""",R[23]C[11],'Voyage Specifics'!RC[-11]))"
    Range("N30").FormulaR1C1 = "=R[-19]"
    Range("N49").FormulaR1C1 = "=R[-19]"
'Heavy Weather Time
    Range("N12").FormulaR1C1 = "=IF(R[7]C[4]<=(R[-4]C[-10]+R[-4]C[-8]),R[7]C[4],""Error"")"
    If IsNumeric(Range("D8").Value) Then
        If Range("R19").Value > (Range("D8").Value + (Range("F8").Value / 60)) Then
            Range("N12").Value = "Error"
        End If
    End If
    Range("N31").FormulaR1C1 = "=R[-19]"
    Range("N50").FormulaR1C1 = "=R[-19]"
'Heavy Weather Distance
    Range("N13").FormulaR1C1 = "=R[7]C[4]"
    Range("N32").FormulaR1C1 = "=R[-19]"
    Range("N51").FormulaR1C1 = "=R[-19]"
'Slow Steaming Time
    Range("N14").FormulaR1C1 = "=IF(R[9]C[4]<=(R[-6]C[-10]+R[-6]C[-8]),R[9]C[4],""Error"")"
    If IsNumeric(Range("D8").Value) Then
        If Range("R23").Value > (Range("D8").Value + (Range("F8").Value / 60)) Then
            Range("N14").Value = "Error"
        End If
    End If
    Range("N33").FormulaR1C1 = "=R[-19]"
    Range("N52").FormulaR1C1 = "=R[-19]"
'Slow Steaming Distance
    Range("N15").FormulaR1C1 = "=R[9]C[4]"
    Range("N34").FormulaR1C1 = "=R[-19]"
    Range("N53").FormulaR1C1 = "=R[-19]"


'Voyage Report Indicators
    Range("Z20").FormulaR1C1 = "=IF('Voyage Specifics'!R[-9]C[-20]=""Exact Route Calculator Enabled"",""Yes"",""No"")"
    Range("Z21").FormulaR1C1 = "=IF(AND((Notes!R[-8]C[-14]+Notes!R[-8]C[-13])<((IF(R[-17]C[-20]=""No Data Input"",'Voyage Specifics'!R[-15]C[-23]+'Voyage Specifics'!R[-14]C[-23],R[-17]C[-20]+R[-17]C[-22]))),(Notes!R[-7]C[-14]+Notes!R[-7]C[-13])>((IF(R[-17]C[-20]=""No Data Input"",'Voyage Specifics'!R[-15]C[-23]+'Voyage Specifics'!R[-14]C[-23],R[-17]C[-20]+R[-17]C[-22])))),""Yes"",""No"")"
    Range("Z22").FormulaR1C1 = "=IF('Voyage Specifics'!R[-13]C[-20]=""Loaded"",""L"",""B"")"
    
'Calls Button Macro
  
    Dim w As Worksheet
        Dim a As Button
        Dim b As Button
        Dim c As Button
        Dim d As Button
        Dim e As Button
        Dim f As Button
        Dim g As Button
        Dim h As Button
        Dim j As Button
        Set w = ActiveSheet
   'Print
        Set a = w.Buttons.Add(840, 10, 108, 30)
        a.OnAction = "Print_Sheet"
        a.Characters.Text = "Print"
    'Save
        Set b = w.Buttons.Add(840, 50, 108, 30)
        b.OnAction = "Save_As"
        b.Characters.Text = "Save"
    'Modify Voyage Specifics
        Set c = w.Buttons.Add(840, 90, 108, 30)
        c.OnAction = "Modify_Voyage"
        c.Characters.Text = "Modify Voyage Specifics"
    'Reset Sheet
        Set d = w.Buttons.Add(840, 130, 108, 30)
        d.OnAction = "NoonDel"
        d.Characters.Text = "Reset Sheet"
    'Recalculate Sheet
        Set e = w.Buttons.Add(840, 170, 108, 30)
        e.OnAction = "Recalc_Sheet"
        e.Characters.Text = "Recalculate Sheet"
        
    'Manual Inputs
        Set f = w.Buttons.Add(840, 210, 108, 30)
        f.OnAction = "ManualCalcShow"
        f.Characters.Text = "Manual Inputs"
        
    'ETA Calculator
        Set f = w.Buttons.Add(840, 250, 108, 30)
        f.OnAction = "ETA_CalcShow"
        f.Characters.Text = "Show ETA Calculator"
        
    'ETA Calculator Calculate
        Set g = w.Buttons.Add(568, 490, 108, 30)
        g.OnAction = "ETA_CALC1"
        g.Characters.Text = "ETA Calculator 1"
        g.Visible = False
            
    'ETA Calculator Calculate
        Set h = w.Buttons.Add(688, 490, 108, 30)
        h.OnAction = "ETA_CALC2"
        h.Characters.Text = "ETA Calculator 2"
        h.Visible = False


    'Hide ETA/Manual Inputs
        Set j = w.Buttons.Add(825, 515, 150, 30)
        j.OnAction = "ETACALCHIDE"
        j.Characters.Text = "Hide Manual Inputs/ETA Calculators"
        j.Visible = False
        
        
        
'Cell Formats
    Range("D4,D23,D42").NumberFormat = "h:mm;@"
    Range("F4:H4,F23:H23,F42:H42").NumberFormat = "dd-mmm-yy"
    Range("D11,D30,D49").NumberFormat = "h:mm;@"
    Range("F11:H11,F30:H30,F49:H49").NumberFormat = "dd-mmm-yy"
    Range("N6,N25,N44").NumberFormat = "0.0"
    Range("N9,N28,N47").NumberFormat = "0.0"
    Range("N10,N29,N48").NumberFormat = "0.00"
    Range("N11,N30,N49").NumberFormat = "0.0"


'Conditional Formatting
    With Cells(20, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""Yes""")
        .Interior.Color = 5287936
        .StopIfTrue = False
    End With
    With Cells(20, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""No""")
        .Interior.Color = vbRed
        .StopIfTrue = False
    End With
    With Cells(21, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""Yes""")
        .Interior.Color = 5287936
        .StopIfTrue = False
    End With
    With Cells(21, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""No""")
        .Interior.Color = 15773696
        .StopIfTrue = False
    End With
    With Cells(22, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""L""")
        .Interior.Color = 5287936
        .StopIfTrue = False
    End With
    With Cells(22, 26).FormatConditions.Add(xlCellValue, xlEqual, "=""B""")
        .Interior.Color = 15773696
        .StopIfTrue = False
    End With
    
'Unlocks Input Cells for Use
    Range( _
        "R5:R16,R19:R20,R23:R24,R28,T28,S29:T29,S31:T31,S32:T32,W24:Z25,W26,W27,Y26,Y27,X28:Y32,W33,Y33:Z33,Y34,S6,S7" _
        ).Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    
'Hides ETA Calculators
    Range("Q27:T27,R28,T28,S29:T29,S31:T31,S32:T32").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("P27:T32").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Range("Q27:T32").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("R5").Select


    
'Timestamp Macro
    
'Renables the Calculator
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
          
'Zooms to 80%
    ActiveWindow.Zoom = 80
    Range("R5").Select
                
End Sub
 
Sort by date Sort by votes
The sheetChange was recommended. I'm open to better suggestions if there is something better.

As for the specific sheet part, unless the code was able to modify itself, I don't believe it would work being able to reference a specific sheet because the number of sheets in the workbook is always changing- As I said, sometimes there might be 10 "Noons" (i.e. Noon, Noon2, Noon3, etc) and sometimes there could be 50, but every "Noon" needs to be able to have this timestamp based on the inputs of that activesheet in R5 and W25.

it's most unusual because this workbook was/sometimes works and then sometimes errors.
 
Last edited:
Upvote 0

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
You can refer to the sheet that the change has happened on using the Sh argument/parameter that is passed to the SheetChange event.
 
Upvote 0
Wouldn't that require the sheet to always exist though? Sometimes the workbook has ten "Noons" and sometimes it only has 1. I can't be modifying the code every time I change the number of sheets. Currently it works for the timestamp; it only errors when I try to run the ETA calculator. Today it error'd when I tried to run the calculator without the DTG loaded in the cell.
 
Upvote 0
So thinking more about this- the timestamp works until I try to run the ETA calculator (with nothing in the DTG) box. All of the coding used is included below. maybe it's not the timestamp itself but the calculator? It is the timestamp that gives me the error though...

Note: the error is when I run with D10 (has a value) and I leave S32 blank. The calcs are supposed to run using D10 unless S32 is not blank.

timestamp
Code: 
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)If ActiveSheet.Name = "Developer" _
    Or ActiveSheet.Name = "Notes" _
    Or ActiveSheet.Name = "Ports" _
    Or ActiveSheet.Name = "Voyage Specifics" _
    Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
If Not Intersect(Target, Union(Range("R5"), Range("W25"))) Is Nothing Then
    If Cells(25, 23) <> "" Then
        Cells(4, 6) = Cells(25, 23).Value
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) <> "" And Cells(25, 23) = "" Then
        Cells(4, 6) = Date
        Cells(4, 6).NumberFormat = "dd-mmm-yy"
    ElseIf Cells(5, 18) = "" And Cells(6, 23) = "" Then
        Cells(4, 6) = "No Data Input"
    End If
End If


If ActiveSheet.Range("Z20") = "Yes" Then
   Cells(9, 18) = "Exact"
End If


    .EnableEvents = True
    .ScreenUpdating = True


End With
End Sub

ETA calc 1 code
Code: 
Sub ETA_CALC1()


Dim Path1 As Date
Dim Path2 As Date
Dim Path3 As Double
Dim Path4 As Double
Dim Path5 As Double
Dim Path6 As Double
Dim Path7 As Date
Dim Path8 As Date
Dim DTG As Double
Dim resp As Integer
'This says that the Distance to go should be in D10 but if we want to use a different mileage than what today's report had list, _
(D10 is on the list), we can input into S32 to use our own distance


'This piece ensures "ETA Arrival ZD" is ready
Worksheets("Developer").Range("F3").FormulaR1C1 = "=IF(AND((Notes!R[10]C[6]+Notes!R[10]C[7])<(('Voyage Specifics'!R[6]C[-3]+'Voyage Specifics'!R[7]C[-3])),(Notes!R[11]C[6]+Notes!R[11]C[7])>(('Voyage Specifics'!R[6]C[-3]+'Voyage Specifics'!R[7]C[-3]))),""Yes"",""No"")"


If ActiveSheet.Range("S29").Value = "" Then
    DTG = ActiveSheet.Range("D10").Value
    Else: DTG = ActiveSheet.Range("S29").Value
End If


Path1 = ActiveSheet.Range("R28").Value
Path2 = ActiveSheet.Range("T28").Value
Path3 = DTG


Path5 = Sheets("Developer").Range("G2").Value
Path6 = ActiveSheet.Range("C5").Value
Path7 = ActiveSheet.Range("F4").Value
Path8 = ActiveSheet.Range("D4").Value


Path4 = (Path3 / (((Path2 + Path1 + (TimeSerial(Path5, 0, 0))) - (Path7 + Path8 + (TimeSerial(Path6, 0, 0)))) * 24))




resp = MsgBox("Based on your desired Arrival Time/Date and your mileage input, your speed required to make your ETA is: " & Round(Path4, 1) & " knots" & vbCrLf & vbCrLf & "Would you like to use this ETA for Today's Report?", vbYesNo)
If resp = vbYes Then
    ActiveSheet.Range("W33").Value = Format(Path1, "hh:mm;@")
    ActiveSheet.Range("Y33:Z33").Value = Path2
    End If


End Sub

ETA calc2 (second ETA calculator)
Code: 
Sub ETA_CALC2()


Dim Path1 As Date 'today's date
Dim Path2 As Double 'today's time
Dim Path3 As Double 'today's Zone Description
Dim Path4 As Double 'Answer
Dim Path5 As Double 'Distance to go
Dim Path6 As Double 'speed
Dim Path7 As Double 'arrival zone description
Dim DTG As Double
Dim resp As Integer
'This says that the Distance to go should be in D10 but if we want to use a different mileage than what today's report had list, _
(D10 is on the list), we can input into S32 to use our own distance


'This piece ensures "ETA Arrival ZD" is ready
Worksheets("Developer").Range("F3").FormulaR1C1 = "=IF(AND((Notes!R[10]C[6]+Notes!R[10]C[7])<(('Voyage Specifics'!R[6]C[-3]+'Voyage Specifics'!R[7]C[-3])),(Notes!R[11]C[6]+Notes!R[11]C[7])>(('Voyage Specifics'!R[6]C[-3]+'Voyage Specifics'!R[7]C[-3]))),""Yes"",""No"")"


If ActiveSheet.Range("S32").Value = "" Then
    DTG = ActiveSheet.Range("D10").Value
    Else: DTG = ActiveSheet.Range("S32").Value
End If






Path1 = ActiveSheet.Range("F4").Value
Path2 = ActiveSheet.Range("D4").Value
Path3 = ActiveSheet.Range("C5").Value
Path5 = DTG
Path6 = ActiveSheet.Range("S31").Value
Path7 = Sheets("Developer").Range("G2").Value




Path4 = ((Path1 + (Path2 + Path3)) + ((Path5 / Path6) + TimeSerial(Path7, 0, 0))) 'So this should return an excel number (time and date combined)




resp = MsgBox("Based on your expected speed and your mileage input, your ETA, corrected for arrival local time, is " & CDate(Path4) & vbCrLf & vbCrLf & "Would you like to use this ETA for Today's Report?", vbYesNo)
If resp = 6 Then
    ActiveSheet.Range("W33").Value = Format(CDate(Path4), "hh:mm;@") 'time
    ActiveSheet.Range("Y33:Z33").Value = Format(CDate(Path4), "dd-mmm-yy") 'date
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
584
RoryA
RoryA
K
  • Solved
formating question
Replies
3
Views
312
Micron
M
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
Lacan
  • Solved
Make VBA codes according to one specific sheet and not all entire workbook?
2
Replies
11
Views
365
Lacan
Lacan
A
  • Question Question
Save as dialogue box for excel, but pre populating filename from source word document
Replies
8
Views
252
RoryA
RoryA

Forum statistics

Threads
1,223,910
Messages
6,175,316
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top