UserForms VBA Unloading or Closing the Dialog Box (Clicking OK Button)

[94mustang]

I am needing help with some VBA code. I am getting the "Run-time error '400': Form already displayed; can't show modally" when I click the OK button on my dialog box. My code is to enter two values and move on but I continue to run into this error when I use Unload Me or even Hide. What am I doing wrong?

This code is my OK Button for the UserForm.
Private Sub OKButton_Click()
Range("B3").Value = Val(txtpval.Text)
Range("B4").Value = Val(txtnval.Text)
If Trim(Me.txtpval.Value) = "" Then
Me.txtpval.SetFocus
MsgBox "Please enter a value for both p and n"
End If
If Trim(Me.txtnval.Value) = "" Then
Me.txtnval.SetFocus
MsgBox "Please enter a value for both p and n"
End If
End Sub

This code prevents the user from clicking the "X" in the top left corner to close the dialog box.
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please click the OK Button after entering values!"
End If
End Sub

This is the main code that I am running.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngempty As Long
Dim txtinrange As Long
Dim pnvalue As Integer
txtinrange = WorksheetFunction.CountIf(Range("PastedData"), "*")
rngempty = WorksheetFunction.CountA(Range("PastedData"))
pnvalue = WorksheetFunction.CountA(Range("pnData"))
'Turn Screen Updating Off
Application.ScreenUpdating = False
'If the range is empty or contains text then exit the subroutine.
If rngempty = 0 Then Exit Sub
If txtinrange > 0 Then Exit Sub
'Format the "PastedData" table with borders, font size and font type
'if the user happens to not paste the values.
Range("PastedData").Select
With Selection.Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("PastedData").Interior.Color = RGB(220, 230, 241)
With Selection.Font
.Name = "Arial"
.Size = 12
End With

If pnvalue < 2 Then
pnval.Show
End If

The rest of my code continues below the End If statement.

 

[94mustang]

Mr. Peltier,

Thank you for that advice. It has been invaluable. I am having a problem with a stack overflow error. See previous post for details. To add to the detail, the stack overflow is occurring when I call the UserForm to ask for the values. Also, do you have any advice on resource material?

 

[94mustang]

Mr. Peltier,

Correction on the Stack Overflow error, the UserForm is loading but when I click on the Ok button is when I get the stackover flow.

 

[Jon Peltier]

Oops, I guess I only read your first paragraph.

What is the Worksheet_Change event doing? If the worksheet change event makes a change to another cell, it fires the worksheet change event again from that cell, and so on. This leads to your Stack Overflow (infinite loop).

You might have to rethink how the events work. Sometimes it might help if you wrap the workings of the procedure with Application.EnableEvents = False (which prevents subsequent firing of these events) and True (which reactivates events firing):

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    ' make your changes here
    Application.EnableEvents = True
End Sub

Among the best programming books you'll, approachable and easy to read, yet not oversimplified, is the Power Programming series by John Walkenbach (affiliate link). I'm not familiar with the Mr Excel programming books, but I know they also are popular. For an online programming course, check out Chandoo's popular classes at chandoo.org. There is a ton of free stuff online too, but you need to dig through it and filter it out. If you're good at guessing keywords, Google is a big help. In fact, my two favorite tools for VBA programming are the macro recorder and Google.

 

[94mustang]

Mr. Peltier,
Thank you so much for the resource materials. I will be looking into purchasing this book.
My apologies for the lengthy post but to answer your question of what my Worksheet_Change event is doing will require a bit of detail so this post is going to be lengthy. My entire code is in this post. I added the Application.EnableEvents as you described in your previous post and it did not fix the stack over flow issue. When I press Ctrl+L and see the dialog box for all the occurrences of the stack over, how do I empty this dialog box? I did not quite understand your first statement in your previous post around the Worksheet_Change event firing when it makes changes to another cell. I have provided my entire code here so you could take a look at it and see what the problem might be.
To briefly describe what my macro accomplishes is this: the user pastes data from Minitab (Statistical Software) into a range on the first worksheet named “Diagnostic Measures”. When this data is pasted from Minitab, it removes the conditional formatting of the cells that were affected so I have to use the macro to re-create the conditional formatting for these cells. When this range is populated with values, the macro is ran. The Private Sub Worksheet_Change Event is performing lots of formatting of cells as you see in the code. It also initiates the UserForm if the p and n values are not entered. If the values have been entered before pasting into the range, then the Private Sub Worksheet_Change Event is run and creates two summary sheets (worksheets) which are called “Summary Unsorted” and “Summary Sorted”. The macro performs some sorting and filtering before finishing. I hope I have provided enough detail to describe basically what is going on. I have not yet updated my macro with the new information you have provided to me. I will do that when I can get the macro running again. As always, I appreciate your patience in reviewing my post to help me stay on the right track.

I tried to paste a picture into this post of the appearance of my first worksheet so you could see what it looks like. Not yet figured out how to get a picture in these posts as well as how you are posting the light bluish or grayish Code Block with snippets of macro code. That would be helpful too but that can definitely wait.

Private Sub Workbook_Open()
    Sheets("Regression Outlier Table").Activate
    Range("A1:I1").Select
    With Selection.Font
        .Name = "Arial Narrow"
        .Size = 13
    End With
    Sheets("Diagnostic Measures").Activate
    Range("B3").Select
End Sub
-----------------------------------------------------------------------------------
Private Sub ClearData_Click()
ResetSheets.ClearData
End Sub
-----------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngempty As Long
    Dim txtinrange As Long
    Dim pnvalue As Integer
    Dim pval As Integer
    Dim nval As Integer
       
    txtinrange = WorksheetFunction.CountIf(Range("PastedData"), "*")
    rngempty = WorksheetFunction.CountA(Range("PastedData"))
    pnvalue = WorksheetFunction.CountA(Range("pnData"))
 
'If the range is empty or contains text then exit the subroutine.
   If rngempty = 0 Then Exit Sub
   If txtinrange > 0 Then Exit Sub
 
'Format the four header rows should the user paste the headings from Minitab.
    Range("B13").Select
    ActiveCell.FormulaR1C1 = "SRES"
    Range("C13").Select
    ActiveCell.FormulaR1C1 = "HI"
    Range("D13").Select
    ActiveCell.FormulaR1C1 = "COOK"
    Range("E13").Select
    ActiveCell.FormulaR1C1 = "DFITS"
    Range("B13:E13").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeColor = xlThemeColorDark1
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternThemeColor = xlThemeColorAccent1
        .ThemeColor = xlThemeColorAccent1
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
    End With
 
'Format the "PastedData" table with borders, font size and font type
'if the user happens to not paste the values.
    Range("PastedData").Select
    With Selection.Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
    End With
    Range("PastedData").Interior.Color = RGB(220, 230, 241)
    With Selection.Font
        .Name = "Arial"
        .Size = 12
    End With
 
'Conditional formatting applied to SRES range.
    Range("SRESrng").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
        Formula1:="=-2", Formula2:="=2"
    Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
    End With
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .Color = -16776961
     End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
'Conditional formatting applied to HI range.
    Range("HIrng").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="='Regression Outlier table'!$E$3"
    Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
    End With
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .Color = -16776961
     End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
'Conditional formatting applied to Cook range.
    Range("Cookrng").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreaterEqual _
        , Formula1:="=1"
    Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
    End With
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .Color = -16776961
     End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
'Conditional formatting applied to DFITS range.
    Range("DFITSrng").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlNotBetween, _
        Formula1:="=-1", Formula2:="=1"
    Selection.FormatConditions(Selection.FormatConditions.count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
    End With
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .Color = -16776961
     End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599993896298105
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("B3").Select
 
'Turn Screen Updating Off
    Application.ScreenUpdating = False
 
'If either the p or n value is missing, open UserForms dialog.
    If pnvalue = 2 Then GoTo Nextline
    If pnvalue <= 1 Then
    pnval.Show
    End If
Nextline:
'Copy/Paste data from Dianostic Measures worksheet
'to the Summary Unsorted worksheet and filter Outliers by removing blank cells.
    Range("RawDataTable").Copy
    Sheets("Summary Unsorted").Activate
    ActiveSheet.Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Range("$A$1:$G$10001").AutoFilter Field:=6, Criteria1:="<>"
    ActiveSheet.Range("A1").Select
   
'Copy/Paste data from the Dianostic Measures worksheet
'to the Summary Sorted worksheet and sort by Cnt-descending, Obs-ascending
'and filter the Outliers by rmoving the blank cells.
    Range("RawDataTable").Copy
    Sheets("Summary Sorted").Activate
    ActiveSheet.Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Sheets("Summary Sorted").Sort.SortFields.Add Key:=Range( _
        "G2:G10001"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    Sheets("Summary Sorted").Sort.SortFields.Add Key:=Range( _
        "A2:A10001"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Summary Sorted").Sort
        .SetRange Range("A1:G10001")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'The immediate line below prevents the "Excel found unreadable content..."
'error when opening.
    ActiveWorkbook.Worksheets("Summary Sorted").Sort.SortFields.Clear
    ActiveSheet.Range("$A$1:$G$10001").AutoFilter Field:=6, Criteria1:="<>"
    ActiveSheet.Range("A1").Select
 
'Activate the Summary Unsorted worksheet
    Sheets("Diagnostic Measures").Activate
    ActiveSheet.Range("B3").Select
   
'Turn Screen Updating On
    Application.ScreenUpdating = True
 
'Display Message Box that the Summaries have finished.
    MsgBox "Summaries Completed Successfully", vbOKOnly, "Complete"
 
'Protect the "Diagnostic Measures worksheet from changes.
    ActiveSheet.Protect "password", True, True
End Sub
----------------------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ThisWorkbook.Saved = True
End Sub
----------------------------------------------------------------------------------
Sub ClearData()
'ClearData Macro
'This Macro deletes the cell contents from the two summary worksheets
'and deletes the cell contents from the pasted data table.
 
'Turn Screen Updating Off
    Application.ScreenUpdating = False
 
'Activate the Summary Unsorted worksheet, clear the filter and delete the data.
    Sheets("Summary Unsorted").Activate
    On Error Resume Next
    ActiveSheet.Range("$A$1:$G$10001").AutoFilter Field:=6
    Selection.CurrentRegion.Select
    Selection.ClearContents
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Range("A1").Select
 
'Activate the Summary Sorted worksheet, clear the filter and delete the data.
    Sheets("Summary Sorted").Activate
    ActiveSheet.Range("$A$1:$G$10001").AutoFilter Field:=6
    Selection.CurrentRegion.Select
    Selection.ClearContents
    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Range("A1").Select
 
 'Activate the Diagnostic Measures worksheet, delete the data in the range
 'and delete p and n values.
    Sheets("Diagnostic Measures").Activate
    ActiveSheet.Unprotect "password"
    Range("PastedData").Select
    Selection.ClearContents
    Range("B3:B4").Select
    Selection.ClearContents
    Range("B3").Select
End Sub
----------------------------------------------------------------------------------
Private Sub OKButton_Click()
'The App.EnableEvents code below prevents the
'Run-time error '400': Form already displayed; can't show modally
    Application.EnableEvents = False
    Range("B3").Value = Val(txtpval.Text)
    Range("B4").Value = Val(txtnval.Text)
 
'Checks for an empty field for the p value.
    If Trim(Me.txtpval.Value) = "" Then
        Me.txtpval.SetFocus
        MsgBox "Please enter a whole number for both p and n", , "Empty Field"
        Exit Sub
    End If
 
'Checks to see if p value was exceeded.
    If Trim(Me.txtpval.Value) > 1000 Then
        Me.txtpval.SetFocus
        MsgBox "Enter p value <= 1,000", , "Number Exceeded"
        Exit Sub
    End If
 
'Checks for an empty field for the n value.
    If Trim(Me.txtnval.Value) = "" Then
        Me.txtnval.SetFocus
        MsgBox "Please enter a whole number for both p and n", , "Empty Field"
        Exit Sub
    End If
 
'Checks to see if n value was exceeded.
    If Trim(Me.txtnval.Value) > 10000 Then
        Me.txtpval.SetFocus
        MsgBox "Enter n value <= 10,000", , "Number Exceeded"
        Exit Sub
    End If
 
'The App.EnableEvents code below prevents the
'Run-time error '400' (see first comment)
    Application.EnableEvents = True
    Unload Me
End Sub
-----------------------------------------------------------------------------------
Private Sub txtpval_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If (KeyAscii > 47 And KeyAscii < 58) Then
        KeyAscii = KeyAscii
    Else
        KeyAscii = 0
        MsgBox "Only whole numbers are accepted for both p and n.", , "Whole Numbers Only"
    End If
End Sub
-----------------------------------------------------------------------------------
Private Sub txtnval_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If (KeyAscii > 47 And KeyAscii < 58) Then
        KeyAscii = KeyAscii
    Else
        KeyAscii = 0
        MsgBox "Only whole numbers are accepted for both p and n.", , "Whole Numbers Only"
    End If
End Sub
-----------------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
        MsgBox "Please click the OK Button after entering whole numbers!", , "Values Needed"
    End If
End Sub

 

[Jon Peltier]

That's a lot to review all at once. But I have a few impressions.

First, there's a lot happening in the Worksheet_Change procedure, including changes to the worksheet, which calls the Worksheet_Change procedure, recursively and potentially infinitely.

Suggestion: disable events within the event procedure, so the changes made within the procedure don't then call the procedure. This may go a long way towards fixing the problem.

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False

    ' all that code goes here

    Application.EnableEvents = True
End Sub

To get the code into that block, surround it with code tags (take the spaces out between open and close square brackets):

[ c o d e ]Code Line 1
Line 2
Line 3
etc.[ / c o d e ]

 

[94mustang]

Mr. Peltier,

Where do I place the Application.EnableEvents = False: before my declarations or after? Also, since the stack is overflowing, how do I empty the stack. What I picture is this: I have filled up the stack and need to "knock out the bottom" to empty it. Is there a way to do this or does the Application.EnableEvents = False take care of that?

I am able to create a block now.  My code will be easier to read.  This is awesome.  Thanks for that tip.

 

[94mustang]

Mr. Peltier,

I just inserted the line of code before my declarations and immediately before the End Sub statement in my code and it is still not working. My code does not like me anymore. Could I move all this code to a standard module and have the Private Sub WorkSheet_Change Event just performing my decisions? If I do this, will I still need the Application.EnableEvents in my code in a standard Module? Will I also need this code in my WorkSheet_Change Event code too? This brings me to my next question and it is this: What is the best practices for VBA code? Is there a resource for that too?

 

[Jon Peltier]

I usually put the Enable Events line between declarations and the start of code.

I don't know about filling up and emptying the stack. I though the only way for it to empty was to climb back up the chain of procedure calls or stop execution. Neither is a good solution for code released for general use. (By "general", I mean not the programmer.)

My next suggestion would be to extract the bulk of the code to a regular module and call it from the event procedure, which you've thought of. I think I would probably keep Enable Events in the event procedure, surrounding the call to the procedure in the regular module.

 

[94mustang]

Mr. Peltier,

I will get as much code out of the event handler and get it into a regular module and call it from the event procedure. Stay tuned. I will let you know what happens.

 

[Jon Peltier]

Is the stack still filling up? If so, there might be something wrong with how (or when) you're disabling events.