• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
    • Password Reset
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

Stopping a VBA internal Timer in command button|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / Stopping a VBA internal Timer in command button|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosStopping a VBA internal Timer in co…
sp_PrintTopic sp_TopicIcon
Stopping a VBA internal Timer in command button
Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
1
August 1, 2020 - 8:10 am
sp_Permalink sp_Print

Hi There,

Below is a internal time in VBA where I will give people time in a Openworkbook where it will activate and if its gone past a certain point it will close and save. ALSO I also created a command button to go another workbook, where I want the SUB Time() to STOP running in VBA. Reason being is the database when the command button is opening another workbook, in the background its saving the database that its already opened and then close it - simple. 

The problem is the Sub Time() - is still going on in the background as its in a Loop and I cant access the next database or open when I select the command button.

The workbook is attached but I think it needs checking. You need to go F8 to view the module of spare stock .

Sub Time()
Dim Start, Finish, TotalTime, TotalTimeInMinutes, TimeInMinutes
'StartTimer
Application.DisplayAlerts = True
TimeInMinutes = Sheet1.Range("A1").Value 'Timer is set for 180 minutes; change as needed.
If TimeInMinutes > 5 Then
TotalTimeInMinutes = (TimeInMinutes * 60) - (5 * 60)
Start = Timer
Do While Timer < Start + TotalTimeInMinutes
DoEvents
Loop
Finish = Timer
TotalTime = Finish - Start
Application.DisplayAlerts = False
MsgBox "This file has been open for " & TotalTime / 60 & " minutes. You have 5 minutes to save before Excel closes."
End If

Start = Timer
Do While Timer < Start + (5 * 60)
DoEvents
Loop
Finish = Timer
TotalTime = Finish - Start
'Application.DisplayAlerts = False
'MsgBox "Excel will now close."

ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWorkbook.Close

End Sub

********I also have a stopwatch in my database and that works perfectly. But After I click the command button the Sub Time() has to stop

Private Sub CommandButton4_Click()

' (NEED TO INPUT A CODE TO STOP THE SUB TIME()???)

Application.OnTime EarliestTime:= _
Now + TimeValue("00:00:10"), Procedure:="EndPleaseWait"
PleaseWait
Application.ScreenUpdating = True
Unload frmMenu
Unload Me
Unprotect_All
stop_timer
Workbooks.Open FileName:= _
"H:\PROJECT-OPS\NSW Site Warehouse\Spare - Condell Park\New Spare Stock Order-Matic 2.3\Spare_Parts_Order_Matic_2.3.xlsm"
Application.WindowState = xlMinimized
Workbooks("Bucketty_Order-Matic_2.1.xlsm").Close SaveChanges:=True

End Sub

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
2
August 3, 2020 - 2:25 am
sp_Permalink sp_Print

Hello,

in the following code, I inserted the count down with stop, pause and continue, I hope I can help

I performed the procedures with:

     _ 1 module

     _ 1 userform with: 1 label;  1 textbox; 4 command buttons

 

Place the following lines in a module

Option Explicit

Public Const sCount As Long = 5400 ' secs
Public cTime As Double
Public pauseCount As Boolean

Public Sub StarTimer() ' RUN COUNT DOWN

If cTime > 1 Then
     If pauseCount = False Then
          cTime = cTime
     Else
          cTime = cTime - 1
     End If

UserForm1.Label9.Caption = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")
UserForm1.TextBox1.Text = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")
Application.OnTime Now + TimeSerial(0, 0, 1), "StarTimer"

End If

End Sub

Public Sub stoptime() ' STOP COUNT DOWN

cTime = 0

End Sub

Place the following lines in a Userform module

Option Explicit

Private Sub CommandButton1_Click()

' RUN COUNT DOWN 
cTime = sCount
Call StarTimer
pauseCount = True

End Sub

Private Sub CommandButton2_Click()

pauseCount = False
Call stoptime ' STOP COUNTDOWN

End Sub

Private Sub CommandButton3_Click()

pauseCount = True ' CONTINUE

End Sub

Private Sub CommandButton4_Click()

pauseCount = False ' TAKE A BREAK

End Sub

Private Sub TextBox1_Change()

Dim hTime As Variant, mTime As Variant, sTime As Variant, dtime As Variant
Dim startTime As Date, endTime As Date

Dim tHrs As Long, tMinutes As Long, tSeconds As Long

tSeconds = sCount

tHrs = Int(tSeconds / 3600)
tMinutes = (Int(tSeconds / 60)) - (tHrs * 60)
tSeconds = Int(tSeconds Mod 60)

If Me.TextBox1.Text = "00:05:00" Then
     startTime = tHrs & ":" & tMinutes & ":" & tSeconds ' at the start
     endTime = Me.TextBox1.Text ' at the end

     hTime = DateDiff("h", endTime, startTime)
     mTime = DateDiff("m", endTime, startTime)
     sTime = DateDiff("s", endTime, startTime)

     dtime = hTime & ":" & mTime & ":" & sTime

'     MsgBox "This file has been open for " & Format(dtime, "hh:mm:ss") & ". You have 5 minutes to save before Excel closes."
     MsgBox "This file has been open for " & hTime & " hours, " & mTime & " minutes, " & sTime & " seconds" & ". You have 5 minutes to save before Excel closes."
End If

End Sub



(I attached the sample file)


Miguel,



Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
3
August 3, 2020 - 9:00 am
sp_Permalink sp_Print

Thanks Miguel,

So this means I need to redesign my time allocation?

Also does this mean the code in Userform 1 below, Do I need to put after End if

'MsgBox "This file has been open for " & Format(dtime, "hh:mm:ss") & ". You have 5 minutes to save before Excel closes."
MsgBox "This file has been open for " & hTime & " hours, " & mTime & " minutes, " & sTime & " seconds" & ". You have 5 minutes to save before Excel closes."
End If

****

ActiveWorkbook.Save
Application.DisplayAlerts = True
ActiveWorkbook.Close

WILL THIS SAVE AND CLOSE AFTER THE TIME HAS BEEN ALLOTED???

And do I need to add Call stoptime so that when a person click the command button that the time will stop

Application.OnTime EarliestTime:= _
Now + TimeValue("00:00:10"), Procedure:="EndPleaseWait"
PleaseWait
Application.ScreenUpdating = True
Unload frmMenu
Unload Me
Unprotect_All

**************
Call stoptime ' STOP COUNTDOWN

**************
Workbooks.Open FileName:= _
"H:\PROJECT-OPS\NSW Site Warehouse\Spare - Condell Park\New Spare Stock Order-Matic 2.3\Spare_Parts_Order_Matic_2.3.xlsm"
Application.WindowState = xlMinimized
Workbooks("Bucketty_Order-Matic_2.1.xlsm").Close SaveChanges:=True

ALSO,

In the code 

Option Explicit
' Use this for time allocation
Public Const sCount As Long = 600 ' secs

LASTLY,

Does the code below, can I change to a value thats been arranged for a different user in cell

Option Explicit
' Use this for time allocation
Public Const sCount As Long = 600 ' secs

Public Const sCount As Long = Sheet1.Range("A1").Value

 

This is quite extensive and is very good because I have a cell as timer but you have a useform which I could have as a floating timer.

If you can confirm my reply that would be great.

 

Thanks Miguel

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
4
August 3, 2020 - 8:20 pm
sp_Permalink sp_Print

Hello,

Yes, you can add the rest of your code ... I signaled where to insert.
you can use the stop, pause and continue procedure in any macro you write without needing the command buttons
 
I prefer to have the counter start time on the module and not on the cell.

I placed 4 command buttons on the excel sheet (run, stop, pause & continue), so you can choose whether to have a userform or not.



Examples of changes: in the excel sheet module

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal target As Range)
' LOCK CELLS
If target.Column = 1 Then
     If target.Row = 1 Then
          Beep
          Cells(target.Row, target.Column).Offset(0, 1).Select
          MsgBox Cells(target.Row, target.Column).Address & " Blocked cell, no change allowed!", vbInformation, "Autorization denied!"
     End If
End If

End Sub

Private Sub Worksheet_change(ByVal target As Range)

' TIME CHANGE
Dim xRange As Range
Set xRange = Range("A1")

If Not Application.Intersect(xRange, Range(target.Address)) Is Nothing Then
     If xRange.Text = "00:05:00" Then MsgBox "You have 5 minutes to save before Excel closes.", vbInformation, "Warning!"
     '----------------------------------------
     ' YOU CAN ADD YOUR CODE HERE
     ' ...
     ' YOU CAN ADD HERE PROCEDURE TO STOP OR PAUSE COUNT DOWN
     ' YOU CAN ADD YOUR CODE HERE
     ' ...
     ' IF YOU HAVE INSERTED PROCEDURE TO PAUSE, NOW YOU CAN ADD THE PROCEDURE TO CONTINUE
     '----------------------------------------
     End If
End If

End Sub



Examples of changes: in  module


Option Explicit

Public Const sCount As Long = 5400 ' seconds 'I PREFER TO HAVE TIME HERE, AND IN SECONDS
Public cTime As Double
Public runCount As Boolean

Public Sub StarTimer() ' RUN COUNT DOWN

Dim getTime As String

If cTime > 1 Then
     If runCount = False Then
          cTime = cTime
     Else
          cTime = cTime - 1
     End If

     ' if you don't want to userform, remove the next two lines
     UserForm1.Label9.Caption = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")
     UserForm1.TextBox1.Text = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")

     ' for excel cell to have count down ( if you want)
     Application.ThisWorkbook.Worksheets("Folha1").Range("A1").Value = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")

     getTime = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")

     Application.OnTime Now + TimeSerial(0, 0, 1), "StarTimer"

     If getTime = "00:05:00" Then MsgBox "You have 5 minutes to save before Excel closes."

     '----------------------------------------
     ' YOU CAN ADD YOUR CODE HERE
     ' ...

     ' YOU CAN ADD HERE PROCEDURE TO STOP OR PAUSE COUNT DOWN
     ' YOU CAN ADD YOUR CODE HERE
     ' ...
     ' IF YOU HAVE INSERTED PROCEDURE TO PAUSE, NOW YOU CAN ADD THE PROCEDURE TO CONTINUE
     '----------------------------------------
End If

End Sub

Public Sub stoptime() ' STOP COUNT DOWN & (SHEET COMMANDBUTTON)

cTime = 0

End Sub

Public Sub runCountDown() ' SHEET COMMANDBUTTON

' RUN COUNT DOWN 
cTime = sCount
Call StarTimer
runCount = True

End Sub

Public Sub ContinueRun() ' SHEET COMMANDBUTTON

runCount = True ' CONTINUE

End Sub

Public Sub PauseRun() ' SHEET COMMANDBUTTON

runCount = False ' TAKE A BREAK

End Sub

 

Miguel,

I attached an example with these changes

 

 
 
Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
5
August 6, 2020 - 3:29 pm
sp_Permalink sp_Print

Thanks Miguel,

This works perfectly!

There is one thing. Because I made UserName and passcode login....Who-ever is logged on there is a time allocation table to which the below code refers too on how long a user can be on my database....code as follows (Referred to my previous inquiry)

TimeInMinutes = Sheet19.Range("BB8").Value

You have indicated below or in your previous reply

Option Explicit

Public Const sCount As Long = 60 ' seconds
Public cTime As Double
Public runCount As Boolean

Is there a way in the option so that it refers to time allocation table in my Sheet TAB

Sheet19.Range("BB8").Value

 

I have tried Public Const sCount As Long = Sheet19.Range("BB8").Value BUT debugs on Value

Thanks for your help on this!

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
6
August 6, 2020 - 9:10 pm
sp_Permalink sp_Print

Hello,

you can do it in many ways...


Example 1: to refer to the value in a cell

( Changes in module )

Option Explicit

'Public Const sCount As Long = 5400 ' seconds
Public sCount As Long

Public cTime As Double
Public runCount As Boolean

...


( Changes in Userform module ) ... for sheet module is the same

Private Sub CommandButton1_Click()

If IsNumeric(Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value) = False Then
     MsgBox "The value is not numeric!", vbCritical, "Warning"
     Exit Sub
End If

Dim x As Integer
x = Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value

sCount = x

' RUN COUNT DOWN 
cTime = sCount
Call StarTimer
runCount = True

End Sub

------------------------------------------------------------------------------------------------------

Example 2:

Or you can, if you have multiple users, and each one has a reference as to whether he is a user or an administrator:

( Changes in module )

Public Const sCount As Long = 5400 ' seconds  '  for administrator

Public Const sCount_2 As Long = 1500 ' seconds ' for users

...

Public Sub StarTimer() ' RUN COUNT DOWN

' and here you can use the select case  ( case user or case administrator ...)

 

( Changes in Userform module ) ... for sheet module is the same

 

Private Sub CommandButton1_Click()

' and here you can use the select case  ( case user or case administrator ...)

 

Miguel,

Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
7
August 7, 2020 - 4:11 pm
sp_Permalink sp_Print

Thanks Miguel,

 

I have added 

Option Explicit

'Public Const sCount As Long = 60 ' seconds
Public Const sCount As Long = Folha1.Range("A2").Value
Public cTime As Double
Public runCount As Boolean

 

But its compile error :Constaint expression required???

can you shed something that I missed I do believe it needs a = ??? after As Long...Unless im missing something here

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
8
August 7, 2020 - 6:57 pm
sp_Permalink sp_Print

Hello,

as I explained in my previous reply, writing this way is wrong :

Public Const sCount As Long = Folha1.Range("A2").Value

you have to write as follows

------------------------------------------------------------------------------------------------------
in code module ( I highlighted in blue the altered parts for that purpose )

Option Explicit

Public sCount As Long
Public cTime As Double
Public runCount As Boolean

Public Sub StarTimer() ' RUN COUNT DOWN

Dim getTime As String

If cTime > 1 Then
     If runCount = False Then
          cTime = cTime
     Else
          cTime = cTime - 1
     End If
     ' next 2 lines for userform 
     UserForm1.Label9.Caption = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")
     UserForm1.TextBox1.Text = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")
     ' next line for sheet cell 
     Application.ThisWorkbook.Worksheets("Folha1").Range("A1").Value = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")

     getTime = Format(TimeSerial(0, 0, cTime), "hh:mm:ss")

     Application.OnTime Now + TimeSerial(0, 0, 1), "StarTimer"

     If getTime = "00:05:00" Then MsgBox "You have 5 minutes to save before Excel closes."
     '----------------------------------------
     ' YOU CAN ADD YOUR CODE HERE
     '----------------------------------------
End If

End Sub

Public Sub stoptime() ' STOP COUNT DOWN & (SHEET COMMANDBUTTON)

cTime = 0

End Sub

Public Sub runCountDown() ' SHEET COMMANDBUTTON

If IsNumeric(Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value) = False Then
     MsgBox "The value in A1 is not numeric", vbCritical, "Warning"
     Exit Sub
ElseIf Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Text = "" Then
     MsgBox "No value in cell!", vbCritical, "Warning"
     Exit Sub
End If

Dim x As Integer
x = Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value

sCount = x

' RUN COUNT DOWN 
cTime = sCount
Call StarTimer
runCount = True

End Sub

Public Sub ContinueRun() ' SHEET COMMANDBUTTON

runCount = True ' CONTINUE

End Sub

Public Sub PauseRun() ' SHEET COMMANDBUTTON

runCount = False ' TAKE A BREAK

End Sub


example for userform module ( I highlighted in blue the altered parts for that purpose )

Option Explicit

Private Sub CommandButton1_Click()

If IsNumeric(Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value) = False Then
     MsgBox "The value in A1 is not numeric", vbCritical, "Warning"
     Exit Sub
ElseIf Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Text = "" Then
     MsgBox "No value in cell!", vbCritical, "Warning"
     Exit Sub
End If

Dim x As Integer
x = Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value

sCount = x

' RUN COUNT DOWN 
cTime = sCount
Call StarTimer
runCount = True

End Sub

Private Sub CommandButton2_Click()

runCount = False
Call stoptime ' STOP COUNTDOWN

End Sub

Private Sub CommandButton3_Click()

runCount = True ' CONTINUE

End Sub

Private Sub CommandButton4_Click()

runCount = False ' TAKE A BREAK

End Sub

Private Sub TextBox1_Change()

Dim hTime As Variant, mTime As Variant, sTime As Variant, dtime As Variant
Dim startTime As Date, endTime As Date

Dim tHrs As Long, tMinutes As Long, tSeconds As Long

tSeconds = sCount

tHrs = Int(tSeconds / 3600)
tMinutes = (Int(tSeconds / 60)) - (tHrs * 60)
tSeconds = Int(tSeconds Mod 60)

If Me.TextBox1.Text = "00:05:00" Then
startTime = tHrs & ":" & tMinutes & ":" & tSeconds ' at the start
endTime = Me.TextBox1.Text ' at the end

hTime = DateDiff("h", endTime, startTime)
mTime = DateDiff("m", endTime, startTime)
sTime = DateDiff("s", endTime, startTime)

dtime = hTime & ":" & mTime & ":" & sTime

'MsgBox "This file has been open for " & Format(dtime, "hh:mm:ss") & ". You have 5 minutes to save before Excel closes."
MsgBox "This file has been open for " & hTime & " hours, " & mTime & " minutes, " & sTime & " seconds" & ". You have 5 minutes to save before Excel closes."
End If

End Sub





I attached a workbook with an example of these changes

miguel,



Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
9
August 10, 2020 - 2:16 pm
sp_Permalink sp_Print

Hi Miguel,

 

Yes now I understand!

Its the Sheet module that I had to use

Public Sub runCountDown() ' SHEET COMMANDBUTTON

If IsNumeric(Application.ThisWorkbook.Worksheets("Folha1").Range("A2").Value) = False Then...so on.

 

All is working and is functioning, HOWEVER, in my database I have a log out and save button and even though the time stops saves and close....the workbook reopens !!!!!....I tried different combinations from the the below code. But still it reopens.

Public Sub LogoutSaveClose()
cTime = 0
Application.DisplayAlerts = False
ThisWorkbook.Close SaveChanges:=True
'Workbooks("CountDown-1-2.xlsm").Close SaveChanges:=False
'Application.DisplayAlerts = False
'Application.ThisWorkbook.Close SaveChanges:=True
'ActiveWorkbook.Close SaveChanges:=True
End Sub

I also had in my database (As a fail safe) Before close workbook Code is below. Even still the workbook reopens

Private Sub Workbook_BeforeClose(Cancel As Boolean)
stoptime
'Application.DisplayAlerts = FalseActiveWorkbook.Close SaveChanges:=True

End Sub

 

I do believe this is the tail end of the reconstruction of my time allocation in my database

Thanks for your patience

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
10
August 10, 2020 - 8:14 pm
sp_Permalink sp_Print

Hello,

I made some changes and it works perfectly for me, then tell me if it worked ... I apologize for the lack of time to solve this code the first time, and for some errors I have...

changes in code module

Public Function PauseInEvent(ByVal Delay As Double) ' WAIT A MOMENT WITH LOOP

Dim TheEndOfTime As Double
TheEndOfTime = Timer + Delay

Do While Timer < TheEndOfTime
     DoEvents
Loop

End Function

Public Sub LogoutSaveClose()

runCount = False
Call stoptime ' STOP COUNTDOWN
PauseInEvent (0.1) ' (MACRO) to make a pause

Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Application.ThisWorkbook.Save

PauseInEvent (0.1) ' (MACRO) to make a pause

Application.ThisWorkbook.Close

'it's working for me, but if you don't need to have the excel application open, activate the next line of code 
'Application.Quit

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

I attached a workbook with an example of these changes

Miguel,
Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
11
August 11, 2020 - 9:12 pm
sp_Permalink sp_Print

Thanks for your help Miguel,

 

No need to apologies. 

 

This works perfectly and I like the code pauseinevent putting to sleep the macro which ordinary shouldve been implemented in the first database is a gem! And im quite amazed.

So I've learnt a lot from your coding and hopfully when i do a new database I can add a few more features in the time allocation table.

Much appreciate your hard work and understanding.

 

Thanks

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
12
August 12, 2020 - 8:36 pm
sp_Permalink sp_Print

You're welcome

Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
13
August 19, 2020 - 3:17 pm
sp_Permalink sp_Print

Sorry to disturb you Miguel!,

All is working well!.However since ive been busy at work and heading back to my database I have another problem.

Because in my Open Workbook case with various functions (I provide you the code below) ...log in...splash screens and the like...when I input the runCountDown into the Workbook_Open it doesnt seem to countdown???....Ive tried to take away the Private Sub and do a plain but still nothing.

Is there anything that I missed to make the countdown start uopn opening workbook

Private Sub Workbook_Open()

'Auto_Open detail functions
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"

'Should be true
ActiveWindow.DisplayWorkbookTabs = False
Application.DisplayStatusBar = False
Application.DisplayFormulaBar = False
' Making the Ribbon visible is true
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = False

ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs

Application.ScreenUpdating = False

'Protection modes

Protect_Code_Exclude
GetSheets
VisibleFalse
Showme

'My Spalsh Screen

Application.ScreenUpdating = True
Application.OnTime EarliestTime:= _
Now + TimeValue("00:00:07"), Procedure:="EndSplash"
Showme2

Sheet1.Range("A2").Select

'Time Allocation

runCountDown

 

End

 

Thanks for your help

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
14
August 19, 2020 - 7:44 pm
sp_Permalink sp_Print

Hello,

Without having access to all the procedures (Workbook  in: Private Sub Workbook_Open() ) it is difficult to say what is causing the error.

I added the code that wrote to my workbook, and since I don't have the following macros:

     'Protection modes

     Protect_Code_Exclude
     GetSheets
     VisibleFalse
     Showme

     &

     Application.OnTime EarliestTime:= _
     Now + TimeValue("00:00:07"), Procedure:="EndSplash"
     Showme2

I removed them, and the timer started without any problems, try adding a pause in the procedures, you can adjust the pause time

example:

' ...

'My Spalsh Screen

Application.ScreenUpdating = True
Application.OnTime EarliestTime:= _
Now + TimeValue("00:00:07"), Procedure:="EndSplash"

PauseInEvent (0.01) ' (MACRO) to make a pause ( you can adjust the time )

Showme2

PauseInEvent (0.1) ' (MACRO) to make a pause ( you can adjust the time )

' ...


tell me if it worked, if not, I will need to know how the other macro works,


Miguel,


Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
15
August 21, 2020 - 1:30 pm
sp_Permalink sp_Print

Hi Miguel,

Sorry mate, I found out what is happening here.

In my database, I have protection modes in place to prevent people from doing anything on my interface (main screen/TAB). Hence, in the open workbook code; Protect_Code_Exclude. 

when the database opens (1st time), it does the login parameters ect...then starts counting down. When I log out and save, it does what its told.

When I re-boot, the time had paused after log out and save say 2:30 but no login parameters and no countdown or restart countdown.

Reason being, the Interface has password protection in cells and is locked. Therefore, when the code below

Application.ThisWorkbook.Worksheets("Interface").Range("A1").Value...ect It cant read or implement the time as its protected.

Because my database is large, I cannot compress it enough to send it through. My email address is stevenbehr1@gmail.com. If you send your personal address I send my database in to you so you can look at it.

My only other solution, is to use the userform countdown and to float it when DBase starts, might be more practical???? as it doesn't need protection.

I have tried other codes like my Unprotect_all in Logoutsaveclose then reopen, and because I put runCountDown in the begining of my OpenWorkbook the runCountDown still cant work...PROTECTED!. I can however, Unprotect the workbook then hit run count down button and will restart the clock.

 

Let me know if you want the database and I can send it to you.

 

Thanks

 

Steve

Avatar
Miguel Santos
Member
Members
Level 0
Forum Posts: 80
Member Since:
February 20, 2020
sp_UserOfflineSmall Offline
16
August 21, 2020 - 7:00 pm
sp_Permalink sp_Print sp_EditHistory

Hello,

To avoid this type of conflict, I mentioned that it was preferable that time be written in a macro instead of in a range, and the macro to start counting can be inserted in any macro, which makes it easier to restart counting whenever if you want.

I have time counters on several VBProjects, with ranges and sheets protected by passwords, as well as password protected VBA, without conflicts...

In my opinion, to help (extra forum), we will have to ask permission from the forum Administrators
If authorized, I will try to help... (only then, i send email to you)


Regards,

Miguel,
Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1510
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
17
August 23, 2020 - 12:36 pm
sp_Permalink sp_Print

Hi Guys,

If you need to share large files use OneDrive or DropBox.

Phil

Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
18
August 24, 2020 - 1:13 pm
sp_Permalink sp_Print sp_EditHistory

Thanks Phil and Miguel,

I do have onedrive, but I aslo need a email adress to give access to the database

Thanks

Steve

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1510
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
19
August 24, 2020 - 3:03 pm
sp_Permalink sp_Print

Hi Steve,

You can share a file on OneDrive without needing to email anyone.

Right click the file -> Share

make sure at the top of the pop-up it says 'Anyone with link can edit'

Click on copy link to create the link

Then copy the link it generates and that is what someone else uses to access your file.  You can paste the link in here.

But, I have forwarded the link you emailed me to Miguel.

Phil

Avatar
Steven Behr
Member
Members

Power Query
Level 0
Forum Posts: 85
Member Since:
January 30, 2020
sp_UserOfflineSmall Offline
20
August 24, 2020 - 4:33 pm
sp_Permalink sp_Print

OK then Phil,

 

Thanks for that.

 

Just in case

 

Onedrive

 

Spare_Parts_Order_Matic_2.3.xlsm

 

Dropbox

https://www.dropbox.com/scl/fi.....64fsz1h8xe

See how I go!

 

Steve

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Jessica Stewart, Mark Carlson, Calvin Richardson
Guest(s) 10
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 870
Purfleet: 412
Frans Visser: 346
David_Ng: 306
lea cohen: 219
A.Maurizio: 202
Jessica Stewart: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
yashal minahil
Oluwadamilola Ogun
Yannik H
dectator mang
Francis Drouillard
Orlando Inocente
Jovitha Clemence
Maloxat Axmatovna
Ricardo Freitas
Marko Meglic
Forum Stats:
Groups: 3
Forums: 24
Topics: 6201
Posts: 27185

 

Member Stats:
Guest Posters: 49
Members: 31861
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.