Text Box not Displaying

**Poundland** · 01-14-2016, 03:36 AM

Guys,

I have written some code below, which works and does as intended with one exception, that of the Text Box coding, the Text Box fails to appear on the worksheet whilst the code is in operation. yet if I break code, switch workbooks and back again the text box is displayed.

I have tried moving the text box code to different places within the code structure and played with Screenupdating On and Off but still to no avail.

Is there something obvious that I am missing?

    Sub Exceptions()
   
' Define DateVariables
Dim Dte As Range, DteDestn As Range, UserInput As Long
' Define Hierarchy Variables
Dim Msku As Range, Dept As Range, SubD As Range, Class As Range, SClass As Range, MskuDesc As Range
' Define Hierarchy Destination Variables
Dim MskuDestn As Range, DeptDestn As Range, SubDDestn As Range, ClassDestn As Range, SClassDestn As Range
Dim MskuDescDestn 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 Exceptions As Range, Excep(1 To 6) As Range
' Define Mail Out Variables
Dim OutApp As Object, OutMail As Object
 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
 ' 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
' Requests user for number of weeks to investigate exceptions over
On Error Resume Next
UserInput = InputBox("Please enter the number of weeks that you want to report exceptions over? Min(1), Max (48)" _
                    , "Weeks Exception Selector")
On Error GoTo 0

If UserInput = 0 Then
UserInput = 55
Else
UserInput = UserInput + 6
End If
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 DeptDestn = NewS.Cells(2, 1)
Set SubDDestn = NewS.Cells(2, 2)
Set ClassDestn = NewS.Cells(2, 3)
Set SClassDestn = NewS.Cells(2, 4)
Set MskuDestn = NewS.Cells(2, 5)
Set MskuDescDestn = NewS.Cells(2, 6)
' set exception destinations objects
Set DteDestn = NewS.Cells(2, 7)
Set Excep(1) = NewS.Cells(2, 8)
Set Excep(2) = NewS.Cells(2, 9)
Set Excep(3) = NewS.Cells(2, 10)
Set Excep(4) = NewS.Cells(2, 11)
Set Excep(5) = NewS.Cells(2, 12)
Set Excep(6) = NewS.Cells(2, 13)
' 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 = "Class"
    .Cells(1, 4).Value = "Sub Class"
    .Cells(1, 5).Value = "Master Sku"
    .Cells(1, 6).Value = "MSKU 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
LineF.Activate

         
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
For Each Msku In ActList.Range(ActList.Cells(5, 3), ActList.Cells(5, 3).End(xlDown)).Cells
Application.ScreenUpdating = False
LineF.Cells(5, 6) = Msku.Value ' PLaces Master Sku into Lineflow
Application.ScreenUpdating = False
Set Dept = LineF.Cells(5, 9) ' Captures Hierarchy data from Lineflow update
Set SubD = LineF.Cells(5, 11)
Set Class = LineF.Cells(5, 13)
Set SClass = LineF.Cells(5, 15)
Set MskuDesc = LineF.Cells(5, 7)
Col = 6
' clears exception variables
Excep(1) = ""
Excep(2) = ""
Excep(3) = ""
Excep(4) = ""
Excep(5) = ""
Excep(6) = ""
' Loops through exception range until valid value is found for each exception
Do
Col = Col + 1
For Rw = 75 To 80
Set Exceptions = LineF.Cells(Rw, Col)
If Exceptions.Value <> "" Then
Select Case Excep(1).Value <> "" ' Case routine cycles through each exception and assigns where is nothing
Case False
Excep(1) = Exceptions.Value
Set Dte = LineF.Cells(7, Exceptions.Column) ' captures first exception date
DeptDestn = Dept.Value
SubDDestn = SubD.Value
ClassDestn = Class.Value
SClassDestn = SClass.Value
MskuDestn = Msku.Value
MskuDescDestn = MskuDesc.Value
DteDestn = Dte.Value
a = a + 1 ' Changes the row variable for the destinations
GoTo bb
Case True
End Select
Select Case Excep(2).Value <> ""
Case False
If Excep(1).Value = Exceptions.Value Then
GoTo bb
Else
End If
Excep(2) = Exceptions.Value
GoTo bb
Case True
End Select
Select Case Excep(3).Value <> ""
Case False
If Excep(1).Value = Exceptions.Value Or Excep(2).Value = Exceptions.Value Then
GoTo bb
Else
End If
Excep(3) = Exceptions.Value
GoTo bb
Case True
End Select
Select Case Excep(4).Value <> ""
Case False
If Excep(1).Value = Exceptions.Value Or Excep(2).Value = Exceptions.Value _
Or Excep(3).Value = Exceptions.Value Then
GoTo bb
Else
End If
Excep(4) = Exceptions.Value
GoTo bb
Case True
End Select
Select Case Excep(5).Value <> ""
Case False
If Excep(1).Value = Exceptions.Value Or Excep(2).Value = Exceptions.Value _
Or Excep(3).Value = Exceptions.Value Or Excep(4).Value = Exceptions.Value Then
GoTo bb
Else
End If
Excep(5) = Exceptions.Value
GoTo bb
Case True
End Select
Select Case Excep(6).Value <> ""
Case False
If Excep(1).Value = Exceptions.Value Or Excep(2).Value = Exceptions.Value _
Or Excep(3).Value = Exceptions.Value Or Excep(4).Value = Exceptions.Value _
Or Excep(5).Value = Exceptions.Value Then
GoTo bb
Else
End If
Excep(6) = Exceptions.Value
GoTo bb
Case True
End Select
'Rw = 80
Else
End If
bb:
Next Rw
' Loops until the user defined weeks have been reached or until the Last Exception place has beem filled.
Loop Until Col = UserInput Or Excep(6).Value <> ""
' re-sets the destination Variables
' set hierarchy destination objects
Set DeptDestn = NewS.Cells(a, 1)
Set SubDDestn = NewS.Cells(a, 2)
Set ClassDestn = NewS.Cells(a, 3)
Set SClassDestn = NewS.Cells(a, 4)
Set MskuDestn = NewS.Cells(a, 5)
Set MskuDescDestn = NewS.Cells(a, 6)
' set exception destinations objects
Set DteDestn = NewS.Cells(a, 7)
Set Excep(1) = NewS.Cells(a, 8)
Set Excep(2) = NewS.Cells(a, 9)
Set Excep(3) = NewS.Cells(a, 10)
Set Excep(4) = NewS.Cells(a, 11)
Set Excep(5) = NewS.Cells(a, 12)
Set Excep(6) = NewS.Cells(a, 13)

Next Msku
NewS.Activate
With NewS.Range("A1:L1")
    .AutoFilter
End With
With NewS.UsedRange
    .Columns.AutoFit
End With
Application.DisplayAlerts = False
WkbNew.SaveAs ("I:\H914 Development and Supply Chain\Lineflow\Developments Exceptions\Developments Exceptions " & Format(Now, "yyyy.mm.dd") & " .xlsx")
WkbNew.Close False
Application.DisplayAlerts = True
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
Application.ScreenUpdating = True
MsgBox ("The Exception Report will now be emailed to all parties")
'Mail Routine
 With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
  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 Exceptions\Developments Exceptions " & 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

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

**Bob Phillips** · 01-14-2016, 03:47 AM

Post the workbook, can't help without seeing the actual objects. ALso tell us what steps to reproduce the issue.

**SamT** · 01-14-2016, 02:47 PM

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

**mikerickson** · 01-14-2016, 08:28 PM

Put

Application.ScreenUpdating = True

into the code when you want the text box to be visible. Sometimes you have to force that to see changes in shapes or text boxes.

**Poundland** · 01-15-2016, 02:00 AM

Sam T, thank you for your help on this buddy, when it comes to VBA writing I am still pretty green but learning all the time.

I will certainly take all your advice on board.

snb · 01-15-2016, 06:56 AM

NewS.Range("A1:L1")=split("Department_Sub Department_rngClass_Sub rngClass_Master Sku_rngMsku Desc_First Exception Date_1st Exception_2nd Exception_3rd Exception_4th Exception_5th Exception_6th Exception","_")

Thread: Text Box not Displaying

Thread Tools

Display

Text Box not Displaying

Posting Permissions