This Workbook event code for Workbook_WindowResize

S

sspatriots

Well-known Member
Joined
Nov 22, 2011
Messages
585
Office Version
  1. 365
Platform
  1. Windows
Good morning,

Trying to use the event code above to fire when I minimize a screen and again when I maximize it does something else. I was under the impression that since I have this code in the "This Workbook" module that it only applied to the workbook that the code is in. However, if I minimize my workbook and open a different workbook and run some code while that one is sitting minimized, the WindowResize event in the first workbook starts to run and does things to the second workbook I opened that were intended to happen to the original workbook when I maximized it again. How do I avoid this? I'm basically using it to stop code from running while it is minimized and then start again when maximize on the first workbook. Any suggestions would be greatly appreciated.


Thanks, SS
 
Sort by date Sort by votes
Got it!
VBA Code: 
Private Sub Workbook_WindowResize(ByVal Wn As Window)
Dim CurrentlyElapsed As Variant, ElapsedTime As Variant


  
    If Wn.WindowState = xlMaximized Then
        MsgBox "Maximized " & Wn.Caption

        'CurrentlyElapsed = Now() - x.Sheets("Sheet1").Range("E1").Value

        'ElapsedTime = CurrentlyElapsed + x.Sheets("Sheet1").Range("C4").Value

        'x.Sheets("Sheet1").Range("C4").Value = ElapsedTime

        'StartTimer
    ElseIf Wn.WindowState = xlMinimized Then
        MsgBox "Minimized " & Wn.Caption
        Debug.Print "Minimized"
        'x.Sheets("Sheet1").Range("E1").Value = Now()

        'StopTimer
    

    End If
    
    
End Sub
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
This pops up if I have two or more excel files open at the same time when I minimize the "TimerTest.xlsm" file. Which tells me it is firing because the next workbook is maximized.
Maximized Message.jpg
 
Upvote 0
Skyybot said:
Got it!
VBA Code: 
Private Sub Workbook_WindowResize(ByVal Wn As Window)
Dim CurrentlyElapsed As Variant, ElapsedTime As Variant


 
    If Wn.WindowState = xlMaximized Then
        MsgBox "Maximized " & Wn.Caption

        'CurrentlyElapsed = Now() - x.Sheets("Sheet1").Range("E1").Value

        'ElapsedTime = CurrentlyElapsed + x.Sheets("Sheet1").Range("C4").Value

        'x.Sheets("Sheet1").Range("C4").Value = ElapsedTime

        'StartTimer
    ElseIf Wn.WindowState = xlMinimized Then
        MsgBox "Minimized " & Wn.Caption
        Debug.Print "Minimized"
        'x.Sheets("Sheet1").Range("E1").Value = Now()

        'StopTimer
  

    End If
  
  
End Sub
Click to expand...
Forgot to mention to change all of the x's to Wn.
sspatriots said:
Looking at your last suggestion now. Thanks
Click to expand...
@sspatriots , sorry. I test for some things and not others, thereby not solving your problem. I think I've finally got everything you're looking for working correctly. Try this. Also, where are the StartTimer and StopTimer Subs located? What is the code in them?
VBA Code: 
Private Sub Workbook_WindowResize(ByVal Wn As Window)
Dim CurrentlyElapsed As Variant, ElapsedTime As Variant, x As Variant

Set x = ThisWorkbook
  
    If Wn.WindowState = xlMaximized Then
        MsgBox "Maximized " & Wn.Caption
        
        
        
        CurrentlyElapsed = Now() - x.Sheets("Sheet1").Range("E1").Value

        ElapsedTime = CurrentlyElapsed + x.Sheets("Sheet1").Range("C4").Value

        x.Sheets("Sheet1").Range("C4").Value = ElapsedTime

        StartTimer
    ElseIf Wn.WindowState = xlMinimized Then
        MsgBox "Minimized " & Wn.Caption
       
        
        x.Sheets("Sheet1").Range("E1").Value = Now()

        StopTimer
    

    End If
   
    
End Sub
 
Upvote 0
That works ok until I go to open another file. Although it doesn't alter the next file I open now, the first file (TimerTest) temporarily maximizes and the timer stops. Any time it it maximized I need it to start again and capture the lapsed time it was temporarily minimized into the total time. I thought I had this resolved in an earlier post of mine, but started doing weird stuff when I opened other files.

VBA Code: 
Sub StartTimer()

    Dim Start As Variant, RunTime As Variant, CurrentlyElapsed As Variant
    Dim ElapsedTime As String
    
    'Set the control cell to 0 and make it green
    Range("B1").Value = 0
    Range("C4").Interior.Color = 13561798 'Light Green
    Range("C4").Font.Color = 24832 'Dark Green

    'If Range("D1").Value <> 0 Then CurrentlyElapsed = Range("D1").Value
    
    Start = Time - Range("C4").Value  ' Set start time subtract existing count
    Debug.Print Start
    Do While Range("B1").Value = 0
        
        DoEvents    ' Yield to other processes.
 '       RunTime = Timer    ' current elapsed time
 '       CurrentlyElapsed = RunTime - Start + Range("D1").Value
        CurrentlyElapsed = Time - Start
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm:ss")
         ElapsedTime = Format(CurrentlyElapsed, "hh:mm:ss")
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm")
        'Display currently elapsed time in C4
        Range("C4").Value = ElapsedTime
        Application.StatusBar = ElapsedTime
            
    Loop
        
    Range("C4").Value = ElapsedTime
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = CurrentlyElapsed
    Application.StatusBar = False

End Sub

Sub StopTimer()

    'Set the control cell to 1
    Range("B1").Value = 1

    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red

End Sub

Sub ResetTimer()

Dim myRange As Range
Dim CopyRange As Range
Dim answer As Integer

Set CopyRange = Range("C4")

On Error Resume Next

answer = MsgBox("Would you like to capture this time for one of the listed task?", vbQuestion + vbYesNo + vbDefaultButton2, "Capture or Clear Time Shown")

If answer = vbYes Then
'  MsgBox "Yes"

Set myRange = Application.InputBox(Prompt:="Select Cell you want to capture your total time in.", Title:="Format Titles", Type:=8)

If myRange Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If

CopyRange.Value = (CopyRange * 24 * 60 * 60) / 3600
myRange.Value = CopyRange.Value

Else
'  MsgBox "No"
End If

    If Range("B1").Value > 0 Then
       
        'Set the control cell to 1
        Range("C4").Value = Format(0, "hh:mm:ss")
'        Range("C4").Value = Format(0, "hh:mm")
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = 0
    
    End If
    
End Sub
 
Upvote 0
sspatriots said:
That works ok until I go to open another file. Although it doesn't alter the next file I open now, the first file (TimerTest) temporarily maximizes and the timer stops. Any time it it maximized I need it to start again and capture the lapsed time it was temporarily minimized into the total time. I thought I had this resolved in an earlier post of mine, but started doing weird stuff when I opened other files.

VBA Code: 
Sub StartTimer()

    Dim Start As Variant, RunTime As Variant, CurrentlyElapsed As Variant
    Dim ElapsedTime As String
   
    'Set the control cell to 0 and make it green
    Range("B1").Value = 0
    Range("C4").Interior.Color = 13561798 'Light Green
    Range("C4").Font.Color = 24832 'Dark Green

    'If Range("D1").Value <> 0 Then CurrentlyElapsed = Range("D1").Value
   
    Start = Time - Range("C4").Value  ' Set start time subtract existing count
    Debug.Print Start
    Do While Range("B1").Value = 0
       
        DoEvents    ' Yield to other processes.
 '       RunTime = Timer    ' current elapsed time
 '       CurrentlyElapsed = RunTime - Start + Range("D1").Value
        CurrentlyElapsed = Time - Start
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm:ss")
         ElapsedTime = Format(CurrentlyElapsed, "hh:mm:ss")
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm")
        'Display currently elapsed time in C4
        Range("C4").Value = ElapsedTime
        Application.StatusBar = ElapsedTime
           
    Loop
       
    Range("C4").Value = ElapsedTime
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = CurrentlyElapsed
    Application.StatusBar = False

End Sub

Sub StopTimer()

    'Set the control cell to 1
    Range("B1").Value = 1

    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red

End Sub

Sub ResetTimer()

Dim myRange As Range
Dim CopyRange As Range
Dim answer As Integer

Set CopyRange = Range("C4")

On Error Resume Next

answer = MsgBox("Would you like to capture this time for one of the listed task?", vbQuestion + vbYesNo + vbDefaultButton2, "Capture or Clear Time Shown")

If answer = vbYes Then
'  MsgBox "Yes"

Set myRange = Application.InputBox(Prompt:="Select Cell you want to capture your total time in.", Title:="Format Titles", Type:=8)

If myRange Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If

CopyRange.Value = (CopyRange * 24 * 60 * 60) / 3600
myRange.Value = CopyRange.Value

Else
'  MsgBox "No"
End If

    If Range("B1").Value > 0 Then
      
        'Set the control cell to 1
        Range("C4").Value = Format(0, "hh:mm:ss")
'        Range("C4").Value = Format(0, "hh:mm")
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = 0
   
    End If
   
End Sub
Click to expand...
Where is this Sub located?
 
Upvote 0
Tried to update the last reply and it timed out, added a few more macros to the reply...

That works ok until I go to open another file. Although it doesn't alter the next file I open now, the first file (TimerTest) temporarily maximizes and the timer stops. Any time it it maximized I need it to start again and capture the lapsed time it was temporarily minimized into the total time. I thought I had this resolved in an earlier post of mine, but started doing weird stuff when I opened other files.


In This Workbook I also have:
VBA Code: 
Private Sub Workbook_Open()

'Dim strWBName As String
'
'strWBName = ActiveWorkbook.Name

    Range("F1").Value = ActiveWorkbook.Name


    ResumeOrRestart

End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Range("D1").Value = Range("C4").Value

    StopTimer

End Sub



VBA Code: 
Option Explicit

' Written by Philip Treacy, My Online Training Hub
' https://www.myonlinetraininghub.com/timer-stopwatch-excel-vba
Public Start As Variant

Sub StartTimer()

    Dim Start As Variant, RunTime As Variant, CurrentlyElapsed As Variant
    Dim ElapsedTime As String
   
    'Set the control cell to 0 and make it green
    Range("B1").Value = 0
    Range("C4").Interior.Color = 13561798 'Light Green
    Range("C4").Font.Color = 24832 'Dark Green

    'If Range("D1").Value <> 0 Then CurrentlyElapsed = Range("D1").Value
   
    Start = Time - Range("C4").Value  ' Set start time subtract existing count
    Debug.Print Start
    Do While Range("B1").Value = 0
       
        DoEvents    ' Yield to other processes.
 '       RunTime = Timer    ' current elapsed time
 '       CurrentlyElapsed = RunTime - Start + Range("D1").Value
        CurrentlyElapsed = Time - Start
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm:ss")
         ElapsedTime = Format(CurrentlyElapsed, "hh:mm:ss")
'        ElapsedTime = Format(CurrentlyElapsed / 86400, "hh:mm")
        'Display currently elapsed time in C4
        Range("C4").Value = ElapsedTime
        Application.StatusBar = ElapsedTime
           
    Loop
       
    Range("C4").Value = ElapsedTime
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = CurrentlyElapsed
    Application.StatusBar = False

End Sub

Sub StopTimer()

    'Set the control cell to 1
    Range("B1").Value = 1

    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red

End Sub

Sub ResetTimer()

Dim myRange As Range
Dim CopyRange As Range
Dim answer As Integer

Set CopyRange = Range("C4")

On Error Resume Next

answer = MsgBox("Would you like to capture this time for one of the listed task?", vbQuestion + vbYesNo + vbDefaultButton2, "Capture or Clear Time Shown")

If answer = vbYes Then
'  MsgBox "Yes"

Set myRange = Application.InputBox(Prompt:="Select Cell you want to capture your total time in.", Title:="Format Titles", Type:=8)

If myRange Is Nothing Then
    MsgBox "No selection made", vbCritical, "Input required"
    Exit Sub
End If

CopyRange.Value = (CopyRange * 24 * 60 * 60) / 3600
myRange.Value = CopyRange.Value

Else
'  MsgBox "No"
End If

    If Range("B1").Value > 0 Then
      
        'Set the control cell to 1
        Range("C4").Value = Format(0, "hh:mm:ss")
'        Range("C4").Value = Format(0, "hh:mm")
    Range("C4").Interior.Color = 13551615 'light Red
    Range("C4").Font.Color = 393372 'Dark Red
    Range("D1").Value = 0
   
    End If
   
End Sub

Sub ResumeOrRestart()

Dim Result As VbMsgBoxResult

Result = MsgBox("Select 'Yes' to resume from your previous clocked time. Select 'No' to automatically 'RESET' the 'Stopwatch'", vbYesNo + vbQuestion)

    If Result = vbYes Then
    
            'MsgBox "You clicked Yes"
    
        If Range("B1").Value > 0 Then
           
            'Set the control cell to 1
            Range("C4").Value = Format(0, "hh:mm:ss")
            'Range("C4").Value = Format(0, "hh:mm")
            Range("C4").Interior.Color = 13551615 'light Red
            Range("C4").Font.Color = 393372 'Dark Red
        
        End If
    
        Range("C4").Value = Range("D1").Value
    
        Else:
        
            'MsgBox "You clicked No"
    
         If Range("B1").Value > 0 Then
           
            'Set the control cell to 1
            Range("C4").Value = Format(0, "hh:mm:ss")
            'Range("C4").Value = Format(0, "hh:mm")
            Range("C4").Interior.Color = 13551615 'light Red
            Range("C4").Font.Color = 393372 'Dark Red
            Range("D1").Value = 0
            
        End If
    
        Range("C4").Value = Range("D1").Value
      
    End If

End Sub
 
Upvote 0
I noticed that you declared the Start variable twice. The Public Start should be sufficient. Also, I would more explicitly define the Ranges with ThisWorkbook
sspatriots said:
In a regular module
Click to expand...
A Module in the TimerTest Workbook?
 
Upvote 0
sspatriots said:
In a regular module
Click to expand...
Basically this is to keep track of the time when I minimize and stop the timer while minimized. So when restoring the window the timer takes the current time and subtracts the time it was minimized and then adds that to the value in C4 to capture the total time even while minimized. On the flip side, when the user closes the file at the end of the day and reopens the next day, they have the option to resume manually start the clock from where they left off or zero it out. Thanks, Steve
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA Activate Code Emptying Clipboard
Replies
1
Views
257
Skyybot
Skyybot
A
  • Question Question
Procedure works in one workbook but not another
Replies
3
Views
69
AlexanderBB
A
Wil Moosa
  • Solved
WindowState = xlMinimized does not show name of workbook
Replies
3
Views
471
Wil Moosa
Wil Moosa
P
  • Question Question
Checking for Worksheets that already exist
2
Replies
11
Views
310
Logit
Logit
S
  • Solved
Need macro to only close workbook at the end if it wasn't already open when Workbook Open Event runs
Replies
5
Views
479
sspatriots
S

Forum statistics

Threads
1,224,527
Messages
6,179,345
Members
452,907
Latest member
Roland Deschain

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