Auto close message box after 1 minute

[ste33uka]

Hi i use the following code for a message box, is there anyway it would auto close message box on 1 minute if i have not clicked before then?

Private Sub Worksheet_Message()
Dim Msg As Long
    Dim myRange As Range
    Set myRange = Sheet85.Range("BD1:BD999")
    Dim cell As Range
    For Each cell In myRange
        Evaluate (cell)
        If StrComp(cell, "Yes", vbTextCompare) = 0 Then
        Cells(cell.Row, "BA") = 999999
        AppActivate Application.Caption
            Msg = MsgBox("" & vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, vbExclamation)
        End If
    Next
        Set myRange = Sheet85.Range("BE1:BE999")

    For Each cell In myRange
        Evaluate (cell)
        If StrComp(cell, "Yes", vbTextCompare) = 0 Then
        Cells(cell.Row, "BC") = 999999
        AppActivate Application.Caption
            Msg = MsgBox("" & vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, vbExclamation)
           
        End If
    Next                 
    End Sub

 

[Eric W]

Try:

    CreateObject("WScript.Shell").PopUp "Your Message goes Here", 60, "Title", 48

More information here:

Popup Method

docs.microsoft.com

I have a link somewhere that shows a message box that has a countdown timer in it that shows how long before it will close itself. Let me know if you want me to dig that out.

 

[6StringJazzer]

Not with a MsgBox. You have to create your own UserForm. I can think of two approaches:

1. Make the form modeless. Upon activation, in the Sub that calls .Show, start a loop with DoEvents that exits after 1 minute elapses and closes the form (or does nothing if you click--click what, I don't know, you didn't say).

2. Upon activation set a timer using OnTime that will call a Sub to close the form. I am not sure if this requires a modeless form.

Edit: You will probably find the previous post meets your needs and is easier.

 

[RoryA]

FWIW, the Shell.Popup method is notoriously unreliable in VBA.

 

[Eric W]

The link to the code with the countdown timer is post 4 in this thread:

Timed InputBox

Hi all, I have seen this requested on some occasions and the usual answer is to create a userform that looks and behaves like an inputbox and then use OnTime to schedule the closing of the userform upon time-out. In case anyone is interested, I am showing here an alternative that uses the...

www.mrexcel.com

I haven't tested it, but maybe it's more reliable.

 

[ste33uka]

Try:

    CreateObject("WScript.Shell").PopUp "Your Message goes Here", 60, "Title", 48

More information here:

Popup Method

docs.microsoft.com

I have a link somewhere that shows a message box that has a countdown timer in it that shows how long before it will close itself. Let me know if you want me to dig that out.

Hey thanks for suggestion, how could i put the following message in ? i keep getting compile error

Msg = MsgBox("" & vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, vbExclamation)

 

[6StringJazzer]

I do not get a compile error on this if I declare cell as a variable. What is the entire sub where you are using this? Is cell declared? Are you using Option Explicit?

 

[ste33uka]

        Private Sub Worksheet_Message()
Dim Msg As Long
Dim myRange As Range
Set myRange = Sheet85.Range("BD1:BD999")
Dim cell As Range
For Each cell In myRange
Evaluate (cell)
If StrComp(cell, "Yes", vbTextCompare) = 0 Then
Cells(cell.Row, "BA") = 999999
AppActivate Application.Caption
CreateObject("WScript.Shell").PopUp "Your Message goes Here", 60, "Title", 48
End If
Next
Set myRange = Sheet85.Range("BE1:BE999")

For Each cell In myRange
Evaluate (cell)
If StrComp(cell, "Yes", vbTextCompare) = 0 Then
Cells(cell.Row, "BC") = 999999
AppActivate Application.Caption
CreateObject("WScript.Shell").PopUp "Your Message goes Here", 60, "Title", 48
           
End If
Next
End Sub

This is sub i am using
I would like the message to say
("" & vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, vbExclamation)

 

[6StringJazzer]

When you call MsgBox you are using the vbExclamation as the optional second argument. You can't include that in the PopUp call. See code below.

Also, why are you starting the message with vbCrLf?

Also, what do you expect this line of code to do:

Evaluate (cell)

It is a call to a function but you are not assigning the result to anything. So this line of code doesn't do anything.

StrComp here seems like overkill. It works but I would just use

If cell.Value = "Yes"

Also, indentation would help readability.

Private Sub Worksheet_Message()
  
   Dim msg As Long
   Dim myRange As Range
   Set myRange = Sheet85.Range("BD1:BD999")
   Dim cell As Range
   
   For Each cell In myRange
      Evaluate (cell) ' ??????
      If StrComp(cell, "Yes", vbTextCompare) = 0 Then
         Cells(cell.Row, "BA") = 999999
         AppActivate Application.Caption
         CreateObject("WScript.Shell").PopUp vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, 60, "Title", 48
      End If
   Next cell
   
   Set myRange = Sheet85.Range("BE1:BE999")
   
   For Each cell In myRange
      Evaluate (cell)
      If StrComp(cell, "Yes", vbTextCompare) = 0 Then
         Cells(cell.Row, "BC") = 999999
         AppActivate Application.Caption
         CreateObject("WScript.Shell").PopUp vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, 60, "Title", 48
      End If
   Next cell
   
End Sub

 

[ste33uka]

When you call MsgBox you are using the vbExclamation as the optional second argument. You can't include that in the PopUp call. See code below.

Also, why are you starting the message with vbCrLf?

Also, what do you expect this line of code to do:

Evaluate (cell)

It is a call to a function but you are not assigning the result to anything. So this line of code doesn't do anything.

StrComp here seems like overkill. It works but I would just use

If cell.Value = "Yes"

Also, indentation would help readability.

Private Sub Worksheet_Message()

   Dim msg As Long
   Dim myRange As Range
   Set myRange = Sheet85.Range("BD1:BD999")
   Dim cell As Range
 
   For Each cell In myRange
      Evaluate (cell) ' ??????
      If StrComp(cell, "Yes", vbTextCompare) = 0 Then
         Cells(cell.Row, "BA") = 999999
         AppActivate Application.Caption
         CreateObject("WScript.Shell").PopUp vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, 60, "Title", 48
      End If
   Next cell
 
   Set myRange = Sheet85.Range("BE1:BE999")
 
   For Each cell In myRange
      Evaluate (cell)
      If StrComp(cell, "Yes", vbTextCompare) = 0 Then
         Cells(cell.Row, "BC") = 999999
         AppActivate Application.Caption
         CreateObject("WScript.Shell").PopUp vbCrLf & " " & Range("BG" & cell.Row).Value & vbCrLf & Range("BP" & cell.Row).Value & vbCrLf & Range("BQ" & cell.Row) & Range("BR" & cell.Row).Value, 60, "Title", 48
      End If
   Next cell
 
End Sub

im still learning code, half of what you said i dont understand
so i can delete "Evaluate (cell)"
and use " If cell.Value = "Yes"

i tried the code you you added, but it didnt auto close message