Running more than one macro at the same time in Excel

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
Hello all

My problem is that I have put together a stop watch in which I want 2 bits of animated text to start at the same time as I click the button to start the stop watch. I currently can only get it to Call the animations and so it runs both animations in order and then starts the clock. Is it possible to get these working together at the same time?

My code so far is as follows;

Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()

Call Animate_String1
Call Animate_String2

'Seconds and fractions of seconds Timer!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Sheet1").Range("AA1").Value
Sheets("Sheet1").Range("i8").Select
myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)
newTime = Format(myH, "0") & " :" & Format(myM, "0") & " :" & _
myS & " H:M:S"
'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Sheet1").Range("AB1").Value = TotalTime
Sheets("Sheet1").Range("i8").Value = newTime
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Sheet1").Range("i8").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Sheet1").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Sheet1").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
End
End Sub

Sub myQuit()
StopSW = True
End Sub
Sub myReSet()
Sheets("Sheet1").Range("i8").Value = 0
Sheets("Sheet1").Range("AA1").Value = 0
Range("A2:A65536").Select
Selection.ClearContents
Range("i8").Select
ReSetSW = True
SplitSW = False
End Sub
Sub mySplit()
DoEvents
SplitSW = True
End Sub

Sub Animate_String1()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "Time Is Money!!"
For y = 1 To 2 '15 Loops through the scrolling
For x = 1 To 26 'Index number of times
Start = Timer 'Set start to internal timer
delay = Start + 0.15 'Set delay for .15 secs
Do While Timer < delay 'Do the display routine
[h2] = Space(x) & sTxt 'Show 1 str @ a time
DoEvents 'do there things
Loop 'Loop until delay is up
DoEvents
Start = Timer 'and reset the timer
delay = Start + 0.15 'and the delay
Next x 'Show the next str
Next y 'Do this again - 15
[D6] = "" 'Reset
End Sub

Sub Animate_String2()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "£ £ £ £ £ £"
For y = 1 To 2 '15 Loops through the scrolling
For x = 1 To 18 'Index number of times
Start = Timer 'Set start to internal timer
delay = Start + 0.15 'Set delay for .15 secs
Do While Timer < delay 'Do the display routine
[f36] = Space(x) & sTxt 'Show 1 str @ a time
DoEvents 'do there things
Loop 'Loop until delay is up
DoEvents
Start = Timer 'and reset the timer
delay = Start + 0.15 'and the delay
Next x 'Show the next str
Next y 'Do this again - 15
[D6] = "" 'Reset
End Sub

This is my first macro so I am very new to this. I have been tweeking code that I have found to get this so if anyone can walk me through sorting this last hurdle out I would greatly appreciate it.

Thank you very much.
 
Joined
Jul 28, 2006
Messages
1,225
Mike, welcome to board.

There's no way you can run two or more subroutines simultaneously in Excel. No way I know of, that is.
You can achieve the same results with the IETimer control, but it requires a completely different approach.

See the attached workbook. All relevant code is on the code module of Sheet1.
In order to make it work, you need to install the IETimer control to your PC, because it's not there by default.
Download the cab file from this link.
http://activex.microsoft.com/controls/iexplorer/x86/ietimer.cab
Extract it to the C:\Windows\System32 folder.
Register it with the following command (issued at command prompt, or Start->Run):
regsvr32 C:\Windows\system32\ietimer.ocx

You should receive the confirmation message, that the ocx was successfully registered.
Now you can open the attached workbook, and try the commandbutton.
Make sure that the Controls toolbar design mode is switched OFF.

Oh, and try using the CODE tags when posting VBA code. It looks much better. It's the # button above the post editor window. ;)

Jimmy
 

Attachments

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Hi, may I ask what you want to do with the animated string, is it something like a progressbar?
I tried to see what your code does but cannot really understand it.

If it's a waining screen or progressbar you watn that will show while calculations are being carried out I may have a solution for you.
 

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
I had a nasty feeling that it was not going to be easy to run them at the same time.

If every computer that uses the file would need the IEtimer downloaded onto it I am not sure whether this will work as I need to send the file to serval people for use at meetings where I don't think they would want to download files onto rented work laptops etc but I apreciate your help with this and will see how I can use this for personal use. Always nice to learn new things :)

The animations are pretty simple text movements for aesthetic's (text runs from left to right in a loop). The stop watch is used to map the lenght of a meeting so that the cost can be determined for the meeting.

In terms of a progress bar, it would be good to show a £ sign apear each time the cost of the meeting increases by a pound or pop up warnings when say the budget for the meeting has been exceeded. (I have got the caluations for both the budget being exceeded and a runing calculation for the cost of the meeting, currently just conditional formated)

Thank you very much for your time looking into this for me.
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Hi Mike,
Just out of curiosity, what is the whole meaning of this timer?
You want to log something but what?
Meeting, what has a meeting to do with Excel and what's Excel function in it?
Do you want to log something when Excel is started and the stopped or do you want to log the time the macro runs?
I understand that you cannot install on everybody's PC so that's out of the question, but you could write some code that logs a start time and end time of something, but then again, If the exact actions are known it will tell us more.
 

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
I overcame the problem by just adding some different animations that are connected to the 'meeting cost' instead of the timer and it looks ok and more importantly works except one more problem I am having which is when I start the timer and then stop it and then start again it works, however if I then stop it and start it a second time it resets either to 0 or a low number. Any ideas why this happens?

The point of the timer is to have it runing in the background when you start a meeting to give insentive to keep focused and achieve objectives to justify the cost of bringing serveral members of staff together.
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I think that the last time you stop and start it it's outside the loop, and resets the counter.
Could you post the changed code?
 

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
Code:
Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
Call Animate_String1
'Seconds and fractions of seconds Timer!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Cost Calculator").Range("AA1").Value
Sheets("Cost Calculator").Range("i8").Select
myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)
newTime = Format(myH, "0") & " :" & Format(myM, "0") & " :" & _
myS & " H:M:S"
'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Cost Calculator").Range("AB1").Value = TotalTime
Sheets("Cost Calculator").Range("i8").Value = newTime
'Test for "ReSet!"
If ReSetSW = True Then
Sheets("Cost Calculator").Range("i8").Value = 0
Sheets("Cost Calculator").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Cost Calculator").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Cost Calculator").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Cost Calculator").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
End
End Sub
Sub myQuit()
StopSW = True
End Sub
Sub myReSet()
Sheets("Cost Calculator").Range("i8").Value = 0
Sheets("Cost Calculator").Range("AA1").Value = 0
Range("Af2:Af65536").Select
Selection.ClearContents
Range("i8").Select
ReSetSW = True
SplitSW = False
End Sub
Sub mySplit()
DoEvents
SplitSW = True
End Sub
Sub Animate_String1()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "Time Is Money!!"
For y = 1 To 2                        '15 Loops through the scrolling
    For x = 1 To 26                   'Index number of times
        Start = Timer                   'Set start to internal timer
        delay = Start + 0.05            'Set delay for .15 secs
        Do While Timer < delay          'Do the display routine
            [h2] = Space(x) & sTxt      'Show 1 str @ a time
            DoEvents                    'do there things
        Loop                            'Loop until delay is up
        DoEvents
        Start = Timer                   'and reset the timer
        delay = Start + 0.05           'and the delay
    Next x                              'Show the next str
Next y                                  'Do this again - 15
[D6] = ""                               'Reset
End Sub
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I need the sheets references,
Any special value in "Cost Calculator" which sheet is that< the same one with the timer?
Which buttons do I have o add?
Your first sample I have here won't work with Office 2010 so I need to know hat triggers what.
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
I don't really see the use of this but,

I added a loop to keep on going and it looks okay
Right below the line you have 'Test for "Reset!"
you start with
Do While StopSW = False

Code:
'Test for "ReSet!"
Do While StopSW = False
If ReSetSW = True Then

remove the last End before the End Sub and replace it with Loop


Code:
    SplitSW = False
    GoTo myStart
End If
Loop
End Sub
What you do in between will work perfectly since to send thecode to GoTo myStart unless you press the myQuit button, whichever it is the value is set to True and the loop ends.
 

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
Ok the code now looks like this with your suggestions but I get errors;

Code:
Public StopSW As Boolean
Public ReSetSW As Boolean
Public SplitSW As Boolean
Public myTime

Sub stopwatch()
Call Animate_String1
'Seconds and fractions of seconds Timer!
Dim Start, Finish, TotalTime
Dim myHi!, myH%, myMi!, myM%, mySi!, myS%, mySf!, SubTotalT, newTime
'Set timer.
Start = Timer
StopSW = False
ReSetSW = False
myTime = Sheets("Cost Calculator").Range("AA1").Value
Sheets("Cost Calculator").Range("i8").Select
myStart:
'Yield to other processes.
DoEvents
'Calculate time.
Finish = Timer
TotalTime = Finish - Start
SubTotalT = myTime + TotalTime
myHi = Application.WorksheetFunction.RoundDown(SubTotalT / 3600, 0)
myH = myHi
myMi = Application.WorksheetFunction.RoundDown(((SubTotalT - (myH * 3600)) / 60), 0)
myM = myMi
mySi = Application.WorksheetFunction.RoundDown(SubTotalT - ((myH * 3600) + (myM * 60)), 0)
myS = mySi
mySf = SubTotalT - ((myH * 3600) + (myM * 60) + myS)
newTime = Format(myH, "0") & " :" & Format(myM, "0") & " :" & _
myS & " H:M:S"
'Show time on sheet!
'Sheets("Sheet1").Range("A1").Value = Format(myTime + TotalTime, "0.0000") & " Seconds"
Sheets("Cost Calculator").Range("AB1").Value = TotalTime
Sheets("Cost Calculator").Range("i8").Value = newTime
'Test for "ReSet!"
[COLOR=red]Do While StopSW = False[/COLOR]
If ReSetSW = True Then
Sheets("Cost Calculator").Range("i8").Value = 0
Sheets("Cost Calculator").Range("AA1").Value = 0
StopSW = True
'Test for "Stop!"
End If
If Not StopSW = True And SplitSW = False Then
Sheets("Cost Calculator").Range("AA1").Value = TotalTime
GoTo myStart
End If
'Test for "Split!"
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Cost Calculator").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Cost Calculator").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
 
[COLOR=red]SplitSW = False
GoTo myStart
End If
Loop
End Sub[/COLOR]
 
End Sub
Sub myQuit()
StopSW = True
End Sub
Sub myReSet()
Sheets("Cost Calculator").Range("i8").Value = 0
Sheets("Cost Calculator").Range("AA1").Value = 0
Range("Af2:Af65536").Select
Selection.ClearContents
Range("i8").Select
ReSetSW = True
SplitSW = False
End Sub
Sub mySplit()
DoEvents
SplitSW = True
End Sub
Sub Animate_String1()
Dim sTxt As String
Dim x As Integer, y As Integer
Dim Start, delay
sTxt = "Time Is Money!!"
For y = 1 To 2                        '15 Loops through the scrolling
    For x = 1 To 26                   'Index number of times
        Start = Timer                   'Set start to internal timer
        delay = Start + 0.05            'Set delay for .15 secs
        Do While Timer < delay          'Do the display routine
            [h2] = Space(x) & sTxt      'Show 1 str @ a time
            DoEvents                    'do there things
        Loop                            'Loop until delay is up
        DoEvents
        Start = Timer                   'and reset the timer
        delay = Start + 0.05           'and the delay
    Next x                              'Show the next str
Next y                                  'Do this again - 15
[D6] = ""                               'Reset
End Sub
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Of course you get errros, two End Sub !!!!!

Check your code under the red lines !!!!
 

Mike87

Thread Starter
Joined
Oct 27, 2011
Messages
7
Took out the other end sub and still get errors. I am very inexperienced in VBA so forgive the mistakes. It says in break mode.
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
Can you say what the error says?
I cannot guess what you're seeing.
When do you get the error?
The code works here at least if you're using the same code you put in post #8 becasue that's the one I copied.
 

Keebellah

Hans
Trusted Advisor
Joined
Mar 27, 2008
Messages
6,641
There's and End If in there that does'n't belong

See both Red lines, okay you already took away the End Sub.


Code:
If SplitSW = True Then
'Sheets("Sheet1").Range("A65536").End(xlUp).Offset(1, 0).Value = Format(TotalTime, "0.0000")
Sheets("Cost Calculator").Range("A65536").End(xlUp).Offset(1, 0).Value = newTime
Sheets("Cost Calculator").Range("AA1").Value = TotalTime
SplitSW = False
GoTo myStart
End If
 
SplitSW = False
GoTo myStart
[COLOR="red"]End If[/COLOR]
Loop
End Sub
 
[COLOR="Red"]End Sub[/COLOR]
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Staff online

Members online

Top