Problem with consistent "Application.Wait (Now + TimeValue("0:00:10"))"

Hi guys,

Edit: code I am using is at bottom of post.

I have found that:

 Application.Wait (Now + TimeValue("0:00:10"))

Seems to not always last the same amount of time. Is "Now" from when I hit the commandbutton, or is it at this step starts?
How can i make "Now" time stamp from when "this step starts" because I want to display the message for a few seconds, however it seems to give me varying amounts of time.

Thanks,
Jimmy


The "Call DirectorysAndFileExistYorN.CheckFiles" function takes a very long time, a few minutes to run and i think that might be the problem with the "Now".

Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Now + TimeValue("0:00:01"))
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Complete, Files in yellow are misplaced or misnamed."
Application.Wait (Now + TimeValue("0:00:10"))
CommandButton1.Caption = "Press to check if files exist."
End Sub

Originally Posted by JimmyWilliams

Is "Now" from when I hit the commandbutton, or is it at this step starts?

"Now" is the time that line of code is executed. I am unclear as to what you are trying to do here. If that function takes a few minutes then why do you want to wait 1 second before starting it? If you just delete the Wait, then the message will display as long as it takes for that function to run.

In any case, to capture the time the button is pressed do this:

Private Sub CommandButton1_Click()
Dim Start As Double
Start = Now
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Start + TimeValue("0:00:01")) ' wait 1 second from when button was clicked
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Complete, Files in yellow are misplaced or misnamed."
Application.Wait (Now + TimeValue("0:00:10")) ' wait another 10 seconds
CommandButton1.Caption = "Press to check if files exist."
End Sub

Private Sub CommandButton1_Click()
Dim Start1 As Double
Dim Start2 As Double
Start1 = Now
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Start1 + TimeValue("0:00:01")) ' wait 1 second from when button was clicked
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Program Completed! Files in yellow are misplaced or misnamed."
Start2 = Now
Application.Wait (Start2 + TimeValue("0:00:03")) ' wait another 3 seconds
CommandButton1.Caption = "Press to check if files exist."
debug.print "start1= "Start1
debug.print "start2= "Start2
End Sub

I preformed the above test
Start1 = 43139.4122222222
Start2 = 43139.4123958333
So you're right, "Now" is time of the line executed, not time of when the macro started (whoops, my bad!). I don't think the Double is doing anything helpful.



'''''''''''''''''''
You said something about deleting the waits?

Private Sub CommandButton1_Click()
Dim Start As Double
Start = Now
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
TimeValue ("0:00:01")  ' wait 1 second from when button was clicked
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Complete, Files in yellow are misplaced or misnamed."
TimeValue ("0:00:03")  ' wait another 10 seconds
CommandButton1.Caption = "Press to check if files exist."
End Sub

This runs, but has the problem that the button's text does not visible change.
'''''''''''''''''''


My current code is this:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Now + TimeValue("0:00:01")) ' wait 1 second from when button was clicked
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Program Completed! Files in yellow are misplaced or misnamed."
Application.Wait (Now + TimeValue("0:00:03")) ' wait another 3 seconds
CommandButton1.Caption = "Press to check if files exist."
End Sub

I have experimented and found that blue is required because otherwise the excel screen does not update with the "Loading, Please Wait." message (even though I have the "application.screen updating"!)
This currently works and isn't the problem. the code in Blue allows the button's message to appear to users.



The problem is the part in red. The macro does not display the button's new text for 3 seconds, the button quickly flashes to the "Press to check if files exist." message for a split second, and then goes to the "Press to check if files exist."

This is what I would like to happen.
1. Click on the button, and the button changes to "Loading, please wait"
2. Just before the program ends, the button's message changes to "Program Completed! Files in yellow are misplaced or misnamed."
3.I After a few seconds the button changes back to its original name, which is "Press to check if files exist."
(ideally the user should gain control again between steps 2 and 3.)


Thanks,
Jimmy

Where is the button? On a userform or a worksheet?

On the worksheet

Have you tired using

Application.Screenupdating = True
DoEvents

to force a screen refresh?

Try:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait..."
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Complete, Files in yellow are misplaced or misnamed."
DoEvents
Application.Wait (Now + TimeValue("0:00:10"))
CommandButton1.Caption = "Press to check if files exist."
End Sub

I think the most likely issue here is your line calling another macro:

Call DirectorysAndFileExistYorN.CheckFiles

We have no idea what this code does. It could be disabling screenupdates and never turning them back on for example. If it does this, doesnt matter how long you wait after youll never see the update.

I would use DoEvents extremely sparingly. Its meant to allow the system outside of Excel to finish processes before returning control to Excel. Not typically something you want to do unless you are working outside of MS Office via VBA, and even then usually there are better ways to handle it.

DoEvents is sometimes a necessary workaround, particularly in the more recent versions of Excel, where screenupdating behaviour seems to have been altered to not occur as often in high-frequency update scenarios.

Originally Posted by xlnitwit

DoEvents is sometimes a necessary workaround...

I agree. Variable times suggests some process is eating cycles; be polite and let it finish before starting your time-out. Perhaps another possibility is to use Application.OnTime instead of .Wait.

test1.xlsm

Hi guys,
Here is the sheet I am working on. let me know if you have any ideas. I've tired some of the ideas above.
But I have a feeling its because I use "select" cells a lot. I think there must be a better way to do to run the other macros I've made.

Thanks,
Jimmy

Yes, changing sheet selection is an issue, and unnecessary. You can avoid it

Sub CheckFiles()
'Sub Auto_Open()   'If you want to run at open
'Application.ScreenUpdating = False
'20171217
'
'Runs automatically when file opened
'Colours Directories yellow if they do not exist
'Colours files names yellow if they do not exist
'Removes colour if the file exists
'
'--------------------Dimensions---------------------
Dim Str01 As String, Str02 As String
Dim Rng01 As Range, Rng02 As Range, Rng03 As Range, Rng04 As Range
Dim Cell As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFSO01 As Object
Dim objFolder01 As Object
'--------------------Dimensions---------------------
'---------------------Variables---------------------
Str01 = "Document Numbering"
'Directory_Location = Named Group
'File_Name = Named Group of the file
'---------------------Variables---------------------

'-----------------------A0000-----------------------
'Gathers the list of directorys stated within this document
Set Rng01 = ThisWorkbook.Sheets(Str01).Range("Directory_Location").Offset(1, 0)
Call Functions_Module.BlanksToSkip(Rng01, "d", Rng02, 4)

'-----------------------A0000-----------------------
'-----------------------A0001-----------------------
' goes through the directories an sees if any are missing

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFSO01 = CreateObject("Scripting.FileSystemObject")

On Error Resume Next

For Each Cell In Sheets(Str01).Range(Rng01, Rng02)
Set objFolder = objFSO.GetFolder(Cell.Value)

If Err.Number <> "0" Then
Cell.Interior.Color = 65535
GoTo line1:
Else
Cell.Interior.ColorIndex = 0
End If
Err.Clear

Str02 = Cell & "\" & Cell.Offset(0, 1)
'Set objFolder01 = objFSO01.GetFile(Cell.Offset(0, 1))
Set objFolder01 = objFSO01.GetFile(Str02)

If Err.Number <> "0" Then
Cell.Offset(0, 1).Interior.Color = 65535
GoTo line1:
Else
Cell.Offset(0, 1).Interior.ThemeColor = xlThemeColorAccent1
Cell.Offset(0, 1).Interior.TintAndShade = 0.799981688894314
'Cell.Offset(0, 1).Interior.ColorIndex = 0
End If

line1:
Err.Clear
Next Cell
'-----------------------A0001-----------------------

'-----------------------A0002-----------------------
'File_Name check to see if correct
End Sub

and

Function BlanksToSkip(x1 As Range, Direction As String, Optional x2 As Range, Optional Blanks As Long)
'Call Functions_Module.BlanksToSkip(x1, "Right",x2, 1)
'x1 is the start of the search, x2 what will be saved as the result. Optional as you may not want to save x2
'Direction must be "up", "down", "left", "right" or "U", "D", "L", "R"
'If 'Blanks' left out, then assumes zero blanks within data column/row.
'
'BlanksToSkip finishes the program with the selected cell being x2.
'
'Breaks if going up and the has a search attached to row 1.
'Breaks if going left and the search is attached to column1.

Dim AAA As String
AAA = ""
Set x2 = x1
If UCase(Direction) = "UP" Or UCase(Direction) = "U" Then: x = 0: Y = -1: AAA = xlUp
If UCase(Direction) = "DOWN" Or UCase(Direction) = "D" Then: x = 0: Y = 1: AAA = xlDown
If UCase(Direction) = "LEFT" Or UCase(Direction) = "L" Then: x = -1: Y = 0: AAA = xlToLeft
If UCase(Direction) = "RIGHT" Or UCase(Direction) = "R" Then: x = 1: Y = 0: AAA = xlToRight
If AAA = "" Or Blank < 0 Then MsgBox ("Error within 'Direction' or Blanks are negative of function BlanksToSkip"): Exit Function
For ii = 1 To Blanks + 1
    For i = 1 To Blanks + 1
        Do While Not IsEmpty(x2.Offset(i * Y, ii * x))
            Set x2 = x2.End(AAA)
            i = 1
            ii = 1
        Loop
    Next i
Next ii
End Function

I couldn't really see a need for CallByName in there.

what do you mean by CallByName? I'm guessing that's the proper term for selecting?

or do you mean the "Call DirectorysAndFileExistYorN.CheckFiles" (How else could i do it?)

I've made the changes you've suggested about the selects, but im still getting the same problem of the button changing to the "Complete, Files in yellow are misplaced or misnamed." message for a few seconds.

My best solution so far is to use the following:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
Dim i As Long

CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Now + TimeValue("0:00:01")) ' wait 1 second from when button was clicked
    Call DirectorysAndFileExistYorN.CheckFiles
Application.ScreenUpdating = True
Do Until i = 5
    CommandButton1.Caption = "Program Complete! Files in yellow" & vbNewLine & "are misplaced or misnamed."
    i = i + 1
    Loop
Application.Wait (Now + TimeValue("0:00:03")) ' wait another 3 seconds
CommandButton1.Caption = "Press to check if files exist."
End Sub

but even this sometimes doesnt result in the button's text from being displayed, even with xlintwit's changes.

Originally Posted by 6StringJazzer

CallByName is a VBA built-in object method that allows you to call a method of an object by using a variable for the method name. I am not sure what this particular reference to it means since it is the first time it is used in this thread.

I think they're discussing this line from post #1, which is actually just a Call statement:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = True
CommandButton1.Caption = "Loading, Please Wait."
Application.Wait (Now + TimeValue("0:00:01")) ' wait 1 second from when button was clicked
Call DirectorysAndFileExistYorN.CheckFiles
CommandButton1.Caption = "Program Completed! Files in yellow are misplaced or misnamed."
Application.Wait (Now + TimeValue("0:00:03")) ' wait another 3 seconds
CommandButton1.Caption = "Press to check if files exist."
End Sub

PS. I still say a DoEvents statement immediately after changing the Button Caption helps. Jeff, do you have an opinion?

Originally Posted by 6StringJazzer

CallByName is a VBA built-in object method that allows you to call a method of an object by using a variable for the method name. I am not sure what this particular reference to it means since it is the first time it is used in this thread.

that makes two of us, im confused.

Still have the problem of it the text on the button not showing sometimes. I think its because there's loops in other parts of the code or something? which sounds rediculous, a solution would be awesome/ideas.

thanks,
Jimmy

In your BlanksToSkip function you had this loop

        Do While Not IsEmpty(x2.Offset(i * Y, ii * x))
            CallByName(Selection, "End", VbGet, AAA).Select
            Set x2 = Selection
            i = 1
            ii = 1
        Loop

I'm just saying that CallByName was unnecessary. (I do know the difference between Call and CallByName. )

Regarding your button code, the Application.Screenupdating = True lines need to appear after you update the caption, since they should force a screen refresh. I'd also recommend putting a DoEvents line after each one.

Originally Posted by xlnitwit

...I do know the difference between Call and CallByName. ...

Apologies, I should have let you speak for yourself.

Some observations that may be affecting run time.

You have 2,523 styles in the file. You have a named range that for me is #REF. Your used range is significantly past where you have data as well. I would guess your macro may be causing the used range to grow over time (and not cleaning itself up), possibly even duplicating styles too.

As per this article https://msdn.microsoft.com/en-us/vba...e-obstructions:

As I think you pointed out, methods like .select, .activate, etc are not good methods for manipulating objects (ranges, sheets, etc). This is in the article about 3/4 down.

At the bottom of the article ar 2 other performance links worth checking out. I think the below about offsetting from a range is someplace but couldn't locate it.

Offset in a loop is likely a bad idea too if it can be avoided. When possible, store the offset in its own range and then use that (presuming the same offset will be used multiple times).

You have some functionality in your macro that could be done using worksheet functions. For example your Text_To_Hyperlink function.

If Trim(Cell) > "" Then
      If Left(Trim(Cell), 4) = "http" Then  ' handles http and https
        ActiveSheet.Hyperlinks.Add Cell, Trim(Cell.Value)
      Else ' Default to http if no protocol was specified.
        ActiveSheet.Hyperlinks.Add Cell, Trim(Cell.Value)
      End If

I see no difference between the 2 possible outcomes in terms of what is actually done. Also, this could very likely be done using the worksheet function HYPERLINK, potentially combined with IF, TRIM, etc.

I see your checking if a folder exists by trying to set it to an object, why not just use fso's FolderExists() method, returns true/false in 1 line, no need to rely on an error handler to capture if its there or not. Similar thing with using getfile then an error handler, there is also a fileexists method of fso. See this link for examples.

I want to say Application.goto isnt efficient either for the things your using it for. Your essentially using it to select a range.

I do not see any call to your sorting function sub, but sorting collections is not super efficient. Dictionaries are faster and arrays are likely even faster for sorting. See a link here on all 3 and sorting.

Ironically enough, I found some code I used for a similar reason with updating captions, but used it in PowerPoint. May help you. I of course used DoEvents in it but with Timer instead of Application.wait, may need to change it as I cant recall if Excel has the Timer function. You just pass it an interval (1 is what i used) See below:

'Created in PowerPoint 2013 

Sub WaitFor(lngSecs As Long) 
'******DECLARATIONS*************************************************** 

Dim lngWait As Long 

'Error Handler 
On Error GoTo Handler 

'******PREPERATION**************************************************** 
'Store time to wait until 
lngWait = Timer + lngSecs 

'******CODE BODY****************************************************** 
'Loop until target time is reached 
Do While Timer < lngWait 
    'Allows updating 
    DoEvents 
Loop 

'******EXIT CODE****************************************************** 
Exit_Sub: 
    Exit Sub 

'******ERROR HANDLER************************************************** 

Handler: 
    MsgBox "Error" & Err & ": " & Error(Err) & "." 
    GoTo Exit_Sub 
End Sub

So the gist of this routine is you change caption, call this routine passing the delay (start with 1, increase as needed) instead of doing DoEvents and Application.wait in line with your code.

Hope it helps