I come again with new query, I have made the Macro and assigned it on Workbook.open, now I want little bit changed, I want to prompt message BOX which have contains Do You want to Stop Macro ? Option YES and NO, If I clicked on Yes with in 10 seconds of workbook Open, I want to stay on same excel without executing the Macro; otherwise, run the macro if I clicked NO or if 10 seconds is completed.
VBA has a MsgBox function, but you cannot let that one time out like you want.
To get a prompt with time-out functionality, you could use the Popup method of the WScript.Shell object. You can create the Shell object with a CreateObject call, and see the MSDN documentation for the Popup method for more details on how to use it.
#Dharmendra Maybe you can try this code:
Private Sub Workbook_Open()
wbClose
End Sub
Sub wbClose()
Dim time As Integer, prompt As String
time = 10 'this is in seconds format
prompt = "This Workbook will close in " & time & " seconds." & _
vbLf & "Press OK if you want some changes to this Workbook."
With CreateObject("WScript.Shell")
Select Case .Popup(prompt, time, "Message", 0)
Case 1
Exit Sub
End Select
End With
ThisWorkbook.Close True
End Sub
Just do some revisions if you like. Thanks!
Related
I will try to be as clear as possible in the description, so here goes nothing:
I have created a code in which the user selects his excel file and then the macro copies the Sheet from that file into my macro Workbook.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
ActiveSheet.Copy After:=wbook.Sheets(1)
ActiveSheet.Name = "Selected file"
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
This is working, but what I realized is, that there might be cases where the selected file has multiple Sheets.
Is there a way to write the macro in which if my selected file has 1 sheet it runs the above code and if it has more than one sheet to let me select the sheet I want and then run the rest of the code?
Edit:
I thought of another way to handle this — perhaps closer to what you were looking for . . .
It's just an expansion of the basic pause routine that I use occasionally.
This is my "regular" Pause routine (using the Timer function):
Sub Pause(seconds As Single)
Dim startTime As Single
startTime = Timer 'get current timer count
Do
DoEvents 'let Windows "catch up"
Loop Until Timer > startTime + seconds 'repeat until time's up
End Sub
...so, it gave me an idea.
Honestly, I was a little surprised to discover that this works, since it's basically running two sections of code simultaneously.
Code for WaitForUserActivity :
Here's the code I used in the demo above:
Option Explicit
Public isPaused As Boolean
Sub WaitForUserActivity() 'THE 'RUN DEMO' BUTTON runs this sub.
Dim origSheet As String
isPaused = True 'flag "pause mode" as "on"
origSheet = ActiveSheet.Name 'remember current worksheet name
MsgBox "This will 'pause' code execution until you" & vbLf & _
"click the 'Continue' button, or select a different a worksheet."
Application.StatusBar = "PAUSED: Click ""Continue"", or select a worksheet."
Do 'wait for button click or ws change
DoEvents 'yield execution so that the OS can process other events
Loop Until (Not isPaused) Or (ActiveSheet.Name <> origSheet)
If isPaused Then 'the active worksheet was changed
MsgBox "Worksheet '" & ActiveSheet.Name & "' was selected." _
& vbLf & vbLf & "Now the program can continue..."
Else 'the button was clicked
MsgBox "The 'Continue' button was clicked." _
& vbLf & vbLf & "Now the program can continue..."
End If
Application.StatusBar = "Ready"
End Sub
Sub btnContinue() 'THE 'CONTINUE' BUTTON runs this sub.
isPaused = False 'flag "pause mode" as "off"
End Sub
To run the demo:
place the above code in a regular module
make sure the workbook has at least two worksheets
create two command buttons:
one for the "Run Demo" button, assign macro: WaitForUserActivity
one for the "Continue" button, assign macro: btnContinue
click the "Run Demo" button
The key command in the code is the DoEvents Function, which "yields execution so that the operating system can process other events."
DoEvents passes control to the operating system. Control is returned after the operating system has finished processing the events in its queue and all keys in the SendKeys queue have been sent.
DoEvents is most useful for simple things like allowing a user to cancel a process after it has started, for example a search for a file. For long-running processes, yielding the processor is better accomplished by using a Timer or delegating the task to an ActiveX EXE component - and the operating system takes care of multitasking and time slicing.
Any time you temporarily yield the processor within an event procedure, make sure the procedure is not executed again from a different part of your code before the first call returns; this could cause unpredictable results.
Further details (and warnings) at the source.
Original Answer:
Some suggested solutions:
Instead of "stopping" the code you could prompt the user to specify which worksheet.
The easiest way would be with an InputBox where the user would enter an ID number or otherwise identify the worksheet.
More complicated but more robust and professional-looking would be a custom dialog box with the help of a userform. There are several examples and tutorials online such as this one.
You could "pause" execution to give the user a set amount of time to select a worksheet, with a simple timer loop, ad you could even check the worksheet name to see if the user picked a new one, something like this:
Dim startTime As Single, shtName As String
If ThisWorkbook.Worksheets.Count = 1 Then
MsgBox "There is only one worksheet in this workbook."
Else
shtName = ActiveSheet.Name 'get name of active sheet
MsgBox "You have 5 seconds to select a worksheet after clicking OK.", _
vbOKOnly + vbInformation, "Select a worksheet... fast!"
startTime = Timer
Do
DoEvents
Loop Until Timer > startTime + 5
'check if user picked a new worksheet
If ActiveSheet.Name = shtName Then
MsgBox "You didn't select a new worksheet!"
Else
MsgBox "Thanks for selecting a new worksheet!"
End If
End If
It's a little hoakey but could work, especially if proper checks to make sure you've got the correct worksheet now.
I suppose you could create an worksheet event procedure that would run when a worksheet is activated, and checked a global variable to see if your "import procedure" was running, and if so, resume your code... but that would be messy and confusing and would require the code to exist in the workbook you're "importing".
Or, better than any of those would be to programmatically/logically determine which worksheet you need based on the contents of the worksheet. Is there a title? A certain date? Maybe the newest worksheet? Something in a certain cell? There must be something that differentiates it from the others.
Hopefully this gives you some ideas towards a non-linear solution. 😉
As in whole, I would recommend ashleedawg's solution, but if you
insisted on maintaining your code structure, your code could look
something like this:
You can distinguish between amount of Sheets a Workbook has using .Count property of the Sheets object (or Worksheets if you do not want to include Charts) and use InputBox to check for the sheet you want to look for.
MyFile = Application.GetOpenFilename()
Workbooks.Open (MyFile)
If ThisWorkbook.Sheets.Count = 1 Then
ThisWorkbook.ActiveSheet.Copy After:=wbook.Sheets(1)
ThisWorkbook.ActiveSheet.Name = "Selected File"
Else
Dim checkfor As String
checkfor = InputBox("What Sheet should I execute the code for?")
Dim i As Integer
For i = 0 To ThisWorkbook.Sheets.Count
If Trim(LCase(checkfor)) = Trim(LCase(Sheets(i).Name))) Then
ThisWorkbook.Sheets(i).Copy After := wbook.Sheets(1)
ThisWorkbook.Sheets(i).Name = "Selected file"
End If
Next i
End If
Workbooks.Open (MyFile)
ActiveWorkbook.Close SaveChanges:=False
Might need some further tweaking, because I was unsure what exactly you wanted to achieve.
EDIT: I figured it out myself. I feel pretty silly, but replacing "Exit Sub" with "End" works perfectly.
Background: I have a Sub that uses the "Call" function to run multiple subs within one Sub (see Code #1 below).
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
My first code that is called out, "Format_MIUL", prompts the user to save the file, using the following line of code (see Code #2 below). This code works, but the problem is that if the user presses the "Cancel" button, the rest of the code called out in the main sub (Code #1 above) will continue to run. I want ALL code to stop if the user presses the cancel button. I just can't seem to figure out how to do that.
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Any help is greatly appreciated.
The Call keyword has been obsolete for 20 years, you can remove it.
The End keyword will effectively end execution, but it's pretty much a big red "self-destruct" button that you effectively never need to use, given properly structured code.
Looks like Format_MIUL is a Sub procedure. Make it a Function and return a Boolean value that tells the caller whether it's ok to proceed, or if the rest of the operations should be cancelled:
Private Function Format_MUIL() As Boolean
'...
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
'return False if userResponse isn't a filename, True otherwise:
Format_MUIL = Not VarType(userResponse) = vbBoolean
End Function
And now instead of this:
Call Format_MIUL
The caller can do this:
If Not Format_MIUL Then Exit Sub
And there you go, graceful exit without any self-destruct buttons pressed.
I have a series of macros that automates much of a process. I would like to distribute this to my coworkers via Excel Add-In and I have one piece of code I just can't seem to get right.
Here is the "master" code (which works fine):
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Save_As
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds",
vbInformation
End Sub
The code that is giving me trouble is "Save_As". First thing I want the user to do is to save the file as a macro enabled file. Ideally, I want the code to do these things for the user:
Force the user to save as .xlsm
Provide the current file name in the Save As dialog box so they have a file name to already work with.
If the CANCEL button is pressed it must stop the entire macro!
I thought this would be a fairly trivial thing, but so far it has been the toughest part of my code.
Here is what I have tried for the Save_As code:
Application.Dialogs(xlDialogSaveAs).Show , xlOpenXMLWorkbookMacroEnabled
This code is very simple, but it doesn't address the cancel button.
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Again for some reason this doesn't address the cancel button.
I have tried probably a half a dozen different things, most of which are similar to the above codes.
Any help is appreciated.
You have this:
If FileDialog.Show = False Then
Exit Sub
End If
Which does not account for an error, simply recognizing a state. You will want the Exit Sub to happen if there's an error only.
This error handling could be implemented by replacing :
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
With:
On Error GoTo Cat
userResponse = Application.Dialogs(xlDialogSaveAs).Show(52)
Cat:
Exit Sub
Update: After more research, I found this duplicate question: Excel 2016 Workbook.BeforeClose event firing every other time bug. It seems I was using the wrong keywords, and that this is a bug, not a problem with my code. However, I cannot seem to download the version mentioned in the solution. I am running Windows 7 and using Microsoft Office 365 Pro Plus, and Office is stating that the most up to date version available is 16.0.6965.2105
I am trying to use the Workbook_BeforeClose event to test whether a checkbox is checked or not. If not, the user is prompted on whether they want to continue closing with out checking the box. If they choose "Yes," the sheet is cleared and the workbook is saved. If they choose, "No," the box is checked and, "Cancel" is set to true.
This works fine the first time the Workbook_BeforeClose event runs. However, the second time the sheet is closed, the standard Excel "Want to save your changes to..." dialogue box comes up and the Workbook_BeforeClose event does not fire. If I click cancel on the dialogue box and close the workbook a third time, the event fires. Something is being reset when, "Cancel," is clicked in the dialogue box, but I can't figure out what it is. My code is below:
Public Closing as Boolean
Sub Workbook_BeforeClose(Cancel As Boolean)
Debug.Print "Workbook_BeforeClose"
If Closing = True Then Exit Sub 'Closing is used as a switch to stop the event from looping on Application.ThisWorkbook.Close below
Closing = True
If Sheets(1).DraftCheckBox = False Then
If MsgBox("This file is not being saved as a draft. This workbook will be cleared if the draft box is not checked." & vbCr & vbCr & "Would you like to continue?", vbYesNo, "Warning") = vbYes Then
'If "Yes" selected
'Stuff happens here
Application.ThisWorkbook.Close savechanges:=True
Else
'If "No" selected
Sheets(1).DraftCheckBox = True
Cancel = True
End If
End If
Closing = False
End Sub
I know for a fact that Application.EnableEvents is set to True. I also know that the event itself is not firing because there is a stop on the very first line at "Debug.Print" This stop is activated after the first close and I can step through the code. It does not activate at all after the second close, either before or after the dialogue box. Is there anything that I should be doing to prevent the dialogue box from coming up and to force the Workbook_BeforeClose event every time the workbook is closed?
You are already closing the workbook you don't want to call close again, use Save instead.
You also don't need the extra variable if you use the code below. One big question remains...how is your user imitating the Close event? If by the red X then the code below should work. If by a button on your form what does that button code look like?
Note: This is untested code as I don't have your workbook.
Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets(1).DraftCheckBox = False Then
If MsgBox("This file is not being saved as a draft. " + _
"This workbook will be cleared if the draft box is not checked." _
& vbCr & vbCr & "Would you like to continue?", _
vbYesNo, "Warning") = vbYes Then
'If "Yes" selected
'Stuff happens here
Application.ThisWorkbook.Save
Cancel = False 'Just to be sure.
Else
'If "No" selected
Sheets(1).DraftCheckBox = True
Cancel = True
End If
End If
End Sub
HTH
i have created macro for excel but it seems somewhere i have done something wrong,
i want to fetch an image from a URL and then update it up to 1 second (more or less)
Sub GetPicture()
PictureURL = "This is where i put the URLi want"
Set MyPict = ActiveSheet.Pictures.Insert(PictureURL)
Cells(1).Value = Now
nextTime = Now + TimeValue("00:00:01")
End Sub
when i run the macro doesn't do anything,only when i press f5 the it updates as fast as i press f5,also what is the value to update less than 1 second ("00:00:01"),when i try ("00:00:0.5") it comes up with "run time error 13" "type mismatch"
Any help is very much apreciated.
In Excel, you can use VBA to trigger code that updates a Worksheet on specific intervals. The code below shows how you would activate a Timer each time the Worksheet is activated by a user. Whenever the Timer fires (on 1 second intervals here) this code updates Cell A1 in the ActiveSheet with the current Time.
To further customize, you would add code to the OnTimerMacro in order to update a Picture or whatever else you recurring task might be.
(Props to Hartmut Gierke for his post on the topic.)
Option Explicit
Dim Execute_TimerDrivenMacro As Boolean
Sub Start_OnTimerMacro()
Execute_TimerDrivenMacro = True
Application.OnTime Time + TimeValue("00:00:01"), ActiveSheet.Name & ".OnTimerMacro"
End Sub
Sub Stop_OnTimerMacro()
Execute_TimerDrivenMacro = False
End Sub
Public Sub OnTimerMacro()
If Execute_TimerDrivenMacro Then
' Do something e.g. put the actual time into cell A1 of the active sheet
ActiveSheet.Cells(1, 1).Value = Time
' At the end restart timer
Application.OnTime Time + TimeValue("00:00:01"), ActiveSheet.Name & ".OnTimerMacro"
End If
End Sub
Private Sub Worksheet_Activate()
'Start the timer driven method when opening the sheet
Start_OnTimerMacro
End Sub
Private Sub Worksheet_Deactivate()
'Stop the timer driven method when opening the sheet
Stop_OnTimerMacro
End Sub
if you would like the macro to repeat you have to put it in a do...until loop. The only problem, is that you can't really have the macro run all the time. There has to be a way to stop it. The do...until loop will help with this, but you have to come up with a reasonable exit from the loop. Can you give a little more background as to what you ultimately want this to do?
Also it sounds like you want the running of the macro to be triggered by something other than the pressing of F5. Can you explain when you would like to see it start?