I did not see any obvious errors or reasons the Box didn't show. Unless you are talking about when running the sub from VBA, then Breaking it to look at the Worksheet.

You had the sub and a Variable with the same name. Bad dog, no biscuits for you. I rewrote that horrible Select Case routine you had, which got rid of that variable. I also changed all the Range Variable names to use RPN, ("rngDte As Range, rngDteDestn As Range")

Then I went thru the code and made suggestions (In Comment) as to where a logical place to move the code to a sub routine would be. This would make it much easier to design and trouble shoot. the main routine, "Exceptions," would have very little actual code in it. IT would mostly be calling sub routines that only did a particular small bit of work.

A lot of variables still have not yet been declared. I suggest that you put "Option Explicit" at the top of all you code p[ages, and Compile your code often.
Option Explicit

Sub Exceptions()
     
'*******Module Variables************* Move to below Optiion Explicit*********
     ' Define DateVariables
    Dim rngDte As Range, rngDteDestn As Range
     ' Define Hierarchy Variables
    Dim rngMsku As Range, rngDept As Range, rngSubD As Range, rngClass As Range
    Dim rngSClass As Range, rngMskuDesc As Range
     ' Define Hierarchy Destination Variables
    Dim rngMskuDestn As Range, rngDeptDestn As Range, rngSubDDestn As Range
    Dim rngClassDestn As Range, rngSClassDestn As Range, rngMskuDescDestn As Range
     ' Define Workbook and Worksheet Variables
    Dim Wkb As Workbook, WkbNew As Workbook, Active As Workbook, ActList As Worksheet, LineF As Worksheet, NewS As Worksheet
    Dim rngExceptions As Range, rngExcep(1 To 6) As Range 'rngExeptions not used in my changes
     ' Define Mail Out Variables
    Dim OutApp As Object, OutMail As Object
'**End


    Chk = InputBox("Running this Macro will disable all other Excel workbooks from being accessed until it has completed. Do you want to continue (y) / (n)")
    If Chk = 0 Or Chk = n Then
        MsgBox ("You have chosen to not run this macro")
        Exit Sub
    Else
    End If

     
'****************Sub-Procedure**********
     ' Create a text box on the active worksheet.
     ' (Horizontal position, Vertical posiiton, Box Length, Box Height)
    ActiveSheet.TextBoxes.Add(215, 150, 500, 100).Select
     ' Store the name of Worksheet in variable StoreWSNM.
    StoreWSNM = ActiveSheet.Name
     ' Store the name of Text Box in variable StoreNM
    StoreNM = Selection.Name
     ' Set the Font and Border properties of the text box.
    With Selection
        With Selection.Characters.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 20
        End With
        With Selection.Border
            .LineStyle = xlContinuous
            .ColorIndex = 1
            .Weight = xlThick
        End With
         'Set round corners for the text box.
        .RoundedCorners = True
         'Set message text color to black.
        .Interior.ColorIndex = 15
         'Assign message text to the text box.
        .Characters.Text = "Please Wait... The Exception report is compiling. You will be unable to use Excel until this has finished!"
    End With
'**End

'***************Sub-Procedure**********
     ' Requests user for number of weeks to investigate rngExceptions over
    On Error Resume Next
    UserInput = InputBox("Please enter the number of weeks that you want to report rngExceptions over? Min(1), Max (48)" _
    , "Weeks Exception Selector")
    On Error GoTo 0
     
    If UserInput = 0 Then
        UserInput = 55
    Else
        UserInput = UserInput + 6
    End If
'**End

'***********Sub-Procedure "Sub Initialize()" ***********
    Application.ScreenUpdating = False
     ' set Workbook and Worksheet objects
    Set Wkb = ThisWorkbook
    Set LineF = Wkb.Sheets("Lineflow")
    Set WkbNew = Workbooks.Add
    Set NewS = WkbNew.Sheets("Sheet1")
    Set Active = Workbooks("Active Skus - Developments")
    Set ActList = Active.Sheets("Active Sku List")
     ' set hierarchy destination objects
    Set rngDeptDestn = NewS.Cells(2, 1)
    Set rngSubDDestn = NewS.Cells(2, 2)
    Set rngClassDestn = NewS.Cells(2, 3)
    Set rngSClassDestn = NewS.Cells(2, 4)
    Set rngMskuDestn = NewS.Cells(2, 5)
    Set rngMskuDescDestn = NewS.Cells(2, 6)
     ' set exception destinations objects
    Set rngDteDestn = NewS.Cells(2, 7)
    Set rngExcep(1) = NewS.Cells(2, 8)
    Set rngExcep(2) = NewS.Cells(2, 9)
    Set rngExcep(3) = NewS.Cells(2, 10)
    Set rngExcep(4) = NewS.Cells(2, 11)
    Set rngExcep(5) = NewS.Cells(2, 12)
    Set rngExcep(6) = NewS.Cells(2, 13)
     
'**************Sub Function********
     ' creates headers on new workbook
    With NewS.Range("A1:L1")
        .Cells(1, 1).Value = "Department"
        .Cells(1, 2).Value = "Sub Department"
        .Cells(1, 3).Value = "rngClass"
        .Cells(1, 4).Value = "Sub rngClass"
        .Cells(1, 5).Value = "Master Sku"
        .Cells(1, 6).Value = "rngMsku Desc"
        .Cells(1, 7).Value = "First Exception Date"
        .Cells(1, 8).Value = "1st Exception"
        .Cells(1, 9).Value = "2nd Exception"
        .Cells(1, 10).Value = "3rd Exception"
        .Cells(1, 11).Value = "4th Exception"
        .Cells(1, 12).Value = "5th Exception"
        .Cells(1, 13).Value = "6th Exception"
    End With
'**End Sub
    LineF.Activate
'**End
     
    Application.ScreenUpdating = False
     ' For Next routine to cycle through Master Skus on Active Sku List
    a = 2 ' Variable used to offset row number for destinations
    
'******************** rngMsku Function************
    For Each rngMsku In ActList.Range(ActList.Cells(5, 3), ActList.Cells(5, 3).End(xlDown)).Cells
        Application.ScreenUpdating = False
        LineF.Cells(5, 6) = rngMsku.Value ' PLaces Master Sku into Lineflow
        Application.ScreenUpdating = False
        Set rngDept = LineF.Cells(5, 9) ' Captures Hierarchy data from Lineflow update
        Set rngSubD = LineF.Cells(5, 11)
        Set rngClass = LineF.Cells(5, 13)
        Set rngSClass = LineF.Cells(5, 15)
        Set rngMskuDesc = LineF.Cells(5, 7)
        Col = 6
         
         
'*************Sub-Procedure**********
         ' clears exception variables
        rngExcep(1) = ""
        rngExcep(2) = ""
        rngExcep(3) = ""
        rngExcep(4) = ""
        rngExcep(5) = ""
        rngExcep(6) = ""
         
         ' Loops through exception range until valid value is found for each exception
        
        
 Dim iExcep As Long, iTest As Long
With LineF
  Do
    Col = Col + 1
    For rw = 75 To 80
        If .Cells(rw, Col) <> "" Then
            'For routine cycles through each exception and assigns where is nothing
          For iExcep = 1 To 6
            If rngExcep(iExcep) = "" Then
              For iTest = 1 To iExcep - 1 'Won't test if iExcep = 1
                If rngExcep(iExcep) = rngExcep(iTest) Or rngExcep(iExcep) = .Cells(rw, Col) Then GoTo bb
              Next iTest
              rngExcep(iExcep) = .Cells(rw, Col)
              If iExcep = 1 And rngDte = "" Then
                Set rngDte = LineF.Cells(7, Col) ' captures first exception date
                rngDeptDestn = rngDept.Value
                rngSubDDestn = rngSubD.Value
                rngClassDestn = rngClass.Value
                rngSClassDestn = rngSClass.Value
                rngMskuDestn = rngMsku.Value
                rngMskuDescDestn = rngMskuDesc.Value
                rngDteDestn = rngDte.Value
                'a is not Declared
                a = a + 1 ' Changes the row variable for the destinations
              End If
              GoTo bb
            End If
          Next iExcep
        End If
bb:
    Next rw
      
  Loop Until Col = UserInput Or rngExcep(6).Value <> ""
End With
'**End

'********Sub-Procedure*************
         ' re-sets the destination Variables
         ' set hierarchy destination objects
        Set rngDeptDestn = NewS.Cells(a, 1)
        Set rngSubDDestn = NewS.Cells(a, 2)
        Set rngClassDestn = NewS.Cells(a, 3)
        Set rngSClassDestn = NewS.Cells(a, 4)
        Set rngMskuDestn = NewS.Cells(a, 5)
        Set rngMskuDescDestn = NewS.Cells(a, 6)
         ' set exception destinations objects
        Set rngDteDestn = NewS.Cells(a, 7)
        Set rngExcep(1) = NewS.Cells(a, 8)
        Set rngExcep(2) = NewS.Cells(a, 9)
        Set rngExcep(3) = NewS.Cells(a, 10)
        Set rngExcep(4) = NewS.Cells(a, 11)
        Set rngExcep(5) = NewS.Cells(a, 12)
        Set rngExcep(6) = NewS.Cells(a, 13)
         
    Next rngMsku
'** End rngMsku sub-Procedure
    
'*********************Sub-Procedure
    NewS.Activate
    
    With NewS.Range("A1:L1")
        .AutoFilter
    End With
    
    With NewS.UsedRange
        .Columns.AutoFit
    End With
'**End

    Application.DisplayAlerts = False
    WkbNew.SaveAs ("I:\H914 Development and Supply Chain\Lineflow\Developments rngExceptions\Developments rngExceptions " & Format(Now, "yyyy.mm.dd") & " .xlsx")
    WkbNew.Close False
    Application.DisplayAlerts = True
    
'******************Procedure***********
    LineF.Activate
    LineF.Cells(5, 6) = "" ' Clears Master Sku into Lineflow
     ' Attempt to close the message box down
     ' Makes sure the proper Worksheet is selected.
    Worksheets(StoreWSNM).Select
     ' Makes sure the proper text box is selected.
    ActiveSheet.TextBoxes(StoreNM).Select
     ' Deletes the Please Wait... text box.
    Selection.Delete
'**End

    Application.ScreenUpdating = True
    MsgBox ("The Exception Report will now be emailed to all parties")
     'Mail Routine
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
'*******Sub-Proceduire*******
Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = "scott.atkinson@poundland.co.uk"
        .cc = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ("I:\H914 Development and Supply Chain\Lineflow\Developments rngExceptions\Developments rngExceptions " & Format(Now, "yyyy.mm.dd") & " .xlsx")
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")
        .Send 'or use .Display
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
'**End

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub