Closing UserForm with Timer (userform shows on IF statement)

R

RMXByker

New Member
Joined
Apr 1, 2010
Messages
38
I am experiencing issues closing a userform that I am using as an information pop-up for users when selecting a specific mode in a different userform. I would like the pop-up (LAT_Notice) to present itself for a specified time period after clicking on CommandButton_1. Once the button is clicked, the code verifies that each textbox has values within (I realize I probably did not use the most efficient means here, but it works and I understand it at least) and lastly, checks to see if the mode has the wording "LAT" within. If LAT is found, it presents the LAT_Notice with the informational message. This is what I want timed. Any help is appreciated...

Code: 
Private Sub CommandButton1_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Test Plan")


With ws


ActiveSheet.Unprotect Password:="TEST"
    
  .Range("c3") = Me.Description.Value
  .Range("i3") = Me.RespEngAppr.Value
  .Range("l3") = Me.EngPhone.Value
  .Range("bz1") = Me.TestEng.Value
  .Range("bz2") = Me.ProjectNo.Value
  .Range("bz3") = Me.AltContact.Value
  .Range("bz4") = Me.AltPhone.Value
  .Range("bz8") = Me.DueDate.Value
  .Range("U8") = Me.TONo.Value
  
  .Range("D1").Value = ComboBox1.Value
    
'Coding for error message to pop up for lack of inputted data
  
        If Me.TONo.Value = "" Then
         
           MsgBox "You must complete the TO No field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.ComboBox1.Value = "" Then
         
           MsgBox "You must complete the Test Type field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.Description.Value = "" Then
         
           MsgBox "You must complete the Description field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.RespEngAppr.Value = "" Then
         
           MsgBox "You must complete the Responsible Engineer field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.EngPhone.Value = "" Then
         
           MsgBox "You must complete the Engineer Phone field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.TestEng.Value = "" Then
         
           MsgBox "You must complete the Test Engineer field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.ProjectNo.Value = "" Then
         
           MsgBox "You must complete the Project No. field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
                
        If Me.AltContact.Value = "" Then
         
           MsgBox "You must complete the Alternate Contact field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.AltPhone.Value = "" Then
         
           MsgBox "You must complete the Alternate Contact Phone field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.DueDate.Value = "" Then
         
           MsgBox "You must complete the Due Date field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
        
        If Me.ComboBox1.Value = "LAT" Then


           LAT_Notice.Show
           Application.Wait (Now + TimeValue("00:00:02"))
        
           Exit Sub
           
        End If
  
' End of Coding for error message to pop up for lack of inputted data
  
  ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
    
End With



End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Sort by date Sort by votes
Maybe you can use something like this;

Code: 
CreateObject("WScript.Shell").Popup "This message will disapear in 2 seconds", 2, "Notice"

instead of;

Code: 
LAT_Notice.Show
Application.Wait (Now + TimeValue("00:00:02"))
 
Upvote 0
Thanks Haluk. I like the way the popup functions, but it is not timed from what I can tell in my code. When it pops open, the user must close it instead of it automatically closing. Any ideas?

Here is my current code;

Code: 
Private Sub CommandButton1_Click()

Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Test Plan")


With ws


ActiveSheet.Unprotect Password:="TEST"
    
  .Range("c3") = Me.Description.Value
  .Range("i3") = Me.RespEngAppr.Value
  .Range("l3") = Me.EngPhone.Value
  .Range("bz1") = Me.TestEng.Value
  .Range("bz2") = Me.ProjectNo.Value
  .Range("bz3") = Me.AltContact.Value
  .Range("bz4") = Me.AltPhone.Value
  .Range("bz8") = Me.DueDate.Value
  .Range("U8") = Me.TONo.Value
  
  .Range("D1").Value = ComboBox1.Value
    
'Coding for error message to pop up for lack of inputted data
  
        If Me.TONo.Value = "" Then
         
           MsgBox "You must complete the TO No field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.ComboBox1.Value = "" Then
         
           MsgBox "You must complete the Test Type field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.Description.Value = "" Then
         
           MsgBox "You must complete the Description field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.RespEngAppr.Value = "" Then
         
           MsgBox "You must complete the Responsible Engineer field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.EngPhone.Value = "" Then
         
           MsgBox "You must complete the Engineer Phone field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.TestEng.Value = "" Then
         
           MsgBox "You must complete the Test Engineer field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.ProjectNo.Value = "" Then
         
           MsgBox "You must complete the Project No. field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
                
        If Me.AltContact.Value = "" Then
         
           MsgBox "You must complete the Alternate Contact field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.AltPhone.Value = "" Then
         
           MsgBox "You must complete the Alternate Contact Phone field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
         
        If Me.DueDate.Value = "" Then
         
           MsgBox "You must complete the Due Date field before Inputting Data", vbCritical
           ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
           Exit Sub
                    
         End If
        
        If Me.ComboBox1.Value = "LAT" Then


            CreateObject("WScript.Shell").Popup "LAT PARTS MUST BE PLACED ON LAT RACK", 1, "LAT Part Drop Off Notice"
            Me.Hide
                
           Exit Sub
           
        End If
  
' End of Coding for error message to pop up for lack of inputted data
  
  ActiveSheet.Protect Password:="TEST", AllowInsertingRows:=True, AllowDeletingRows:=True
   
End With
Me.Hide


End Sub
 
Upvote 0
Sorry, i cant understand what you are looking for.

Maybe someone can help you better.
 
Upvote 0
Haluk said:
Sorry, i cant understand what you are looking for.

Maybe someone can help you better.
Click to expand...

Sorry if I am not clear Haluk but thank you for your assistance. I'm looking for exactly what you provided, but with the popup to automatically close after a specific amount of time (no user interaction to close it). The code you provided opens the popup, but I (user) must close it by pressing the X in the upper corner, hitting the Okay button or just pressing ESC on the keyboard. I would like the user to not have to interact with this pop up at all if possible.

Thank you for your assistance up to this part though!
 
Upvote 0
Hi again;

The code i proposed in message #2 should do what you want.

That is; the pop-up window should be automatically closed after 2 seconds, without the need of a user to hit the close button.
 
Upvote 0
Hi,
If not resolved this issue try following:

Place following in a STANDARD module:

Code: 
Public TimeOut As Date


Sub CloseForm(ByVal Form As Object)
Unload Form
End Sub

Note Public Variable - This MUST be OUTSIDE any procedure & placed at TOP of the Module.


Place following in your Forms CODE PAGE

Code: 
Private Sub UserForm_Initialize()
    TimeOut = Now + TimeValue("00:00:02")
    Application.OnTime TimeOut, "'CloseForm Lap_Notice'"
End Sub




Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Application.OnTime EarliestTime:=TimeOut, Procedure:="'CloseForm LAP_Notice'", Schedule:=False
End Sub


In your commandbutton1 code Replace this part:

Code: 
       If Me.ComboBox1.Value = "LAT" Then
           LAT_Notice.Show
           Application.Wait (Now + TimeValue("00:00:02"))
           Exit Sub
        End If

With This:

Code: 
If Me.ComboBox1.Value = "LAT" Then LAT_Notice.Show

Hopefully this will do what you want.

Just an observation - you are testing data entry inputs AFTER you have written data to spreadsheet.

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
406
GK039
G
P
  • Locked
  • Question Question
Edit VBA code to let it automatically create Folder
Replies
5
Views
759
RoryA
RoryA
C
  • Solved
VBA - Checking for Duplicates
Replies
2
Views
882
cwhaley1
C
I
  • Question Question
Add ID number next to customer row from userform transfer
Replies
2
Views
324
Joe4
Joe4
C
  • Solved
VBA how to insert a row after a specific row number only
Replies
6
Views
3K
cypher1985
C

Forum statistics

Threads
1,224,828
Messages
6,181,206
Members
453,022
Latest member
RobertV1609

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