Follows last code

'Generates tables on sheets 1+2. Formulas add up (1's+0's) from named month sheets to make a total for each month
Sub AddFormulas()
Dim MonthColumn As Long
Dim Msg As String
Dim Ws As Long
Dim N As Long
Dim Cnt As Integer

'On Error GoTo ErrorHandlingAddForms

With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        
        
    N = Application.Worksheets.Count - 3

        For Ws = 1 To 2                        'Create tables on sheets 1 + 2.(Tables look up 1's and 0's from month sheets
            With Worksheets(Ws)
                For MonthColumn = 1 To N
                    .Cells(4, MonthColumn + 1).Formula = "=MIN(" & Worksheets(MonthColumn + 3).Range("E:E").Address(External:=True) & ")"
                    .Cells(4, MonthColumn + 1).NumberFormat = "mmm-yy"
                    .Cells(5, MonthColumn + 1).Formula = "=MIN(" & Worksheets(MonthColumn + 3).Range("E:E").Address(External:=True) & ")"
                    .Cells(5, MonthColumn + 1).NumberFormat = "dd/mm/yy"
                    .Cells(6, MonthColumn + 1).Formula = "=MAX(" & Worksheets(MonthColumn + 3).Range("E:E").Address(External:=True) & ")"
                    .Cells(6, MonthColumn + 1).NumberFormat = "dd/mm/yy"
                    .Cells(7, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("B:B").Address(External:=True) & ", ""Production"")"
                    .Cells(8, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("K:K").Address(External:=True) & ", ""1"")"
                    .Cells(9, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("Q:Q").Address(External:=True) & ", ""1"")"
                    .Cells(10, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("P:P").Address(External:=True) & ", ""1"")"
                    .Cells(11, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("R:R").Address(External:=True) & ", ""1"")"
                    .Cells(12, MonthColumn + 1).Formula = "=" & .Cells(13, MonthColumn + 1).Address(False, False) & "+" & .Cells(14, MonthColumn + 1).Address(False, False) & "+" & .Cells(15, MonthColumn + 1).Address(False, False)
                    .Cells(13, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("M:M").Address(External:=True) & ", ""1"")"
                    .Cells(14, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("N:N").Address(External:=True) & ", ""1"")"
                    .Cells(15, MonthColumn + 1).Formula = "=COUNTIF(" & Worksheets(MonthColumn + 3).Range("O:O").Address(External:=True) & ", ""1"")"
                    .Cells(16, MonthColumn + 1).Formula = "=" & .Cells(11, MonthColumn + 1).Address(False, False) & "/" & .Cells(7, MonthColumn + 1).Address(False, False)
                    .Cells(16, MonthColumn + 1).NumberFormat = "0.00%"
                Next MonthColumn
            End With
        Next Ws
  MonthColumn = MonthColumn + 1             'Setting column num to 1 after last, creating the "total" column Number
  Ws = 0
  Dim i As Long
  For Ws = 1 To 2
        With Worksheets(Ws)
            .Cells(4, MonthColumn) = "Total"
                For i = 7 To 15
                    .Cells(i, MonthColumn).FormulaR1C1 = "=SUM(RC2:RC[-1])"     'Adding total Column Sheets 1 + 2
                Next i
            .Cells(16, MonthColumn).FormulaR1C1 = "=AVERAGE(RC2:RC[-1])"
            Range("B4").CurrentRegion.Formula = Range("B4").CurrentRegion.Value
        End With
    Next Ws
    
    Worksheets(2).Select: Selection.Range("B4").CurrentRegion.Formula = Range("B4").CurrentRegion.Value
    Worksheets(1).Activate
    
     For Ws = 1 To 2
            With Worksheets(Ws)
                For MonthColumn = 1 To N + 1
                    .Cells(4, MonthColumn + 1).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
                        For Cnt = 5 To 15
                            .Cells(Cnt, MonthColumn + 1).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin  'Formatting Tables
                        Next Cnt                                                                            'Sheets 1 + 2
                    .Cells(16, MonthColumn + 1).BorderAround ColorIndex:=xlAutomatic, Weight:=xlThin
                Next MonthColumn
            End With
        Next Ws
        
        For Ws = 1 To 2
            With Worksheets(Ws)
                For MonthColumn = 1 To N + 1
                    .Cells(4, MonthColumn + 1).Interior.ColorIndex = 40    'Format colours for "date" and "%"rows of tables 1+2
                    .Cells(16, MonthColumn + 1).Interior.ColorIndex = 40
                Next MonthColumn
            End With
        Next Ws


        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
End With

 
ErrorHandlingAddForms:          ' Error message that will appear if an event occurs
    Select Case Err
        Case 1004 'Object Error
                Msg = MsgBox("Ignor error if less than 12 months are being calculated. Otherwise check there are sheets from which to calculate the tables and retry.", , "Calculation Error!")
        Case 9 ' No data sheets to calulate from
                MsgBox "Err"
                ThisWorkbook.Save
           Exit Sub
        Case Else
    End Select
    
    Call ProbeName
        
End Sub

Sub ProbeName()

Dim ProbeStr As String
Dim R As Range
Dim Cl As Range
Dim Sht3 As Worksheet
Dim Ws As Long

ProbeStr = 0

    With Application.Worksheets(3).Activate
    
        Range("D2").Activate
        Set R = Range(ActiveCell, ActiveCell.End(xlDown))
        R.Select
            For Each Cl In R
                If Cl.Value <> "Probe" Then ProbeStr = Cl.Value
                If ProbeStr <> ActiveCell.Offset(1, 0).Value Then ProbeStr = "All Probe Types": Exit For
                    If ProbeStr = "All Probe Types" Then Application.Worksheets(1).Cells(3, 1) = ProbeStr
        Next Cl
        Application.CutCopyMode = False
    End With

For Ws = 1 To 2
    With Worksheets(Ws)
        .Cells(3, 1) = ProbeStr
    End With
Next Ws

Application.Worksheets(1).Activate

Call RigName

End Sub

Sub RigName()

Dim RigStr As String
Dim R As Range
Dim Cl As Range
Dim Sht3 As Worksheet
Dim Ws As Long

RigStr = 0

    With Application.Worksheets(3).Activate
    
        Range("J2").Activate
        Set R = Range(ActiveCell, ActiveCell.End(xlDown))
        R.Select
            For Each Cl In R
                If Cl.Value <> "Probe" Then RigStr = Cl.Value
                If RigStr <> ActiveCell.Offset(1, 0).Value Then RigStr = "All Rig Numbers": Exit For
                    If RigStr = "All Probe Types" Then Application.Worksheets(1).Cells(3, 2) = RigStr
        Next Cl
        Application.CutCopyMode = False
    End With

For Ws = 1 To 2
    With Worksheets(Ws)
        .Cells(3, 2) = RigStr
    End With
Next Ws


    Worksheets(1).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Worksheets(2).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.Worksheets(1).Activate
End Sub