I am french so sorry for my english i do my best...
I try to call a sub named timer1_tick and i want it to stop my sub "b_reponse1_click". The problem is that my sub dont wait until the end of the timer...
Code:
Sub Process_Globals
Dim Timer1 As Timer
....
End Sub
Sub Activity_Create(FirstTime As Boolean)
Timer1.Initialize("Timer1", 1000) ' 1000 = 1 second
Timer1.Enabled = True
...
End Sub
Sub b_reponse1_Click
p= p + 1
If b_reponse1.Text = r5 Then
score = score + 1
b_reponse1.Color=Colors.Green
CallSub("",timer1_tick) ' Here i call sub timer1_tick
b_reponse1.Color=Colors.Gray
Else
b_reponse1.Color=Colors.Red
b_reponse1.Color=Colors.Gray
End If
If nbqpassee = 10 Then
Activity.RemoveAllViews
Activity.LoadLayout("lay_main")
Else
CallSub("",loadq)
End If
End Sub
Timer1 countdown but my sub b_reponse1_Click continue execution without waiting the end of timer
Timer :
Code:
Sub timer1_tick
t = t + 1
Log(t)
End Sub
I have try this but didn't solve my problem :
Code:
Sub timer1_tick
t = t + 1
Log(t)
timer1.Enabled = False
End Sub
Do you know how can i do to stop my sub b_reponse1_click about to 1 second ?
Thanks by advance for answer !
timer1_tick is a regular sub like any other sub. It will not cause the code execution to wait.
Search the forum for CallSubPlus. You can break your current sub to two subs and then call the second sub with CallSubPlus which will run after the specified time.
Related
Trying to clear the contents if the cell equals 100 after the email is sent to prevent additional emails going out. I'm not wishing to clear all the range. Only if it = 100.
Private Sub Worksheet_Calculate()
If WorksheetFunction.CountIf(Range("I36:I44"), 100) Then
Call Mail_small_Text_Outlook
Range("I36:I44").ClearContents
End If
End Sub
You don't need a loop
Private Sub Worksheet_Calculate()
Dim pos As Variant
pos = Application.Match(100, Range("I36:I44"), 0)
If IsNumeric(pos) Then
Call Mail_small_Text_Outlook
Range("I36:I44").Cells(pos).Value = ""
End If
End Sub
I'm trying to create a simple counting sheet which has 5 buttons to increment the count of each field, a 'New Round' Button to start a new round in a new column (R2 and so forth) and Clear button which clears all the counts and start over again from Round1
So far I've come up with this code:
Function rngLastRound() As Range
With Range("2:2").Cells(1, Columns.Count).End(xlToLeft)
Set rngLastRound = .EntireColumn
End With
End Function
Sub IncrementCurrentRoundOfRow(N As Long)
With rngLastRound
.Cells(N, 1).Value = Val(CStr(.Cells(N, 1).Value)) + 1
End With
End Sub
Sub IncrementCurrentRoundA()
Call IncrementCurrentRoundOfRow(3)
End Sub
Sub IncrementCurrentRoundB()
Call IncrementCurrentRoundOfRow(4)
End Sub
Sub IncrementCurrentRoundC()
Call IncrementCurrentRoundOfRow(5)
End Sub
Sub IncrementCurrentRoundD()
Call IncrementCurrentRoundOfRow(6)
End Sub
Sub IncrementCurrentRoundE()
Call IncrementCurrentRoundOfRow(7)
End Sub
Sub NewRound()
With rngLastRound.Offset(0, 1)
.Cells(2, 1).Value = "R" & (.Column - 1)
.Cells(3, 1).Resize(5, 1).Value = 0
End With
End Sub
Sub Clear()
Range("B2", rngLastRound).ClearContents
Call NewRound
End Sub
The code works fine, but it clears the entire columns so that means the totals and grand total also gets cleared. How do I prevent this from happening by not specifying .EntireColumn attribute and instead a specific range?
Thanks
A Game
Option Explicit
Function rngLastRound() As Range
With Range("2:2").Cells(Columns.Count).End(xlToLeft)
Set rngLastRound = .Resize(6)
End With
End Function
Sub IncrementCurrentRoundOfRow(N As Long)
With rngLastRound
.Cells(N).Value = Val(CStr(.Cells(N).Value)) + 1
End With
End Sub
Sub IncrementCurrentRoundA()
Call IncrementCurrentRoundOfRow(2)
End Sub
Sub IncrementCurrentRoundB()
Call IncrementCurrentRoundOfRow(3)
End Sub
Sub IncrementCurrentRoundC()
Call IncrementCurrentRoundOfRow(4)
End Sub
Sub IncrementCurrentRoundD()
Call IncrementCurrentRoundOfRow(5)
End Sub
Sub IncrementCurrentRoundE()
Call IncrementCurrentRoundOfRow(6)
End Sub
Sub NewRound()
With rngLastRound.Offset(, 1)
.Cells(1).Value = "R" & (.Column - 1)
.Cells(2).Resize(5).Value = 0
End With
End Sub
Sub Clear()
Range("B2", rngLastRound).ClearContents
Call NewRound
End Sub
Try changing the line Set rngLastRound = .EntireColumn in the rngLastRound () function to Set rngLastRound = Application.Intersect (.EntireColumn, Rows ("2: 7"))
I created a ProgressBar I want to display with % while my macro runs.
I tried the parameters UserForm1.Show vbModeless and UserForm1.Repaint in my main macro.
Private Sub UserForm_Activate()
Dim reminder As Long
Dim i As Long, j As Long
reminder = 0
For i = 1 To 200
UserForm1.Label2.Width = UserForm1.Label2.Width + 1
If i Mod 2 = 0 Then
reminder = reminder + 1
UserForm1.Caption1 = reminder & " % completed"
End If
For j = 1 To 150
DoEvents
Next j
Next i
Unload UserForm1
End Sub
The UserForm stops on 0% and my main macro runs to the end, then the UserForm with ProgressBar runs from 0 to 100% and closes.
WORKING:
I create two NON MODAL! Forms NAMED "progressbar"
( with 1 Textbox NAMED counter)
and "tester "
(with 3 Buttons NAMED count hide and show)
the code in progressbar:
Dim count As Long
Public Sub progressbar_show()
count = 0
progressbar.Show
End Sub
Public Sub progressbar_update()
If count < 100 Then count = count + 1
progressbar.counter.Text = Str(count)
DoEvents
End Sub
Public Sub progressbar_close()
counter = 0
progressbar.hide
End Sub
The code in tester: (calls routines in form progressbar)
Private Sub count_Click()
Call progressbar.progressbar_update
End Sub
Private Sub hide_Click()
Call progressbar.progressbar_close
End Sub
Private Sub show_Click()
Call progressbar.progressbar_show
End Sub
Works as designed.
on the click button the textbox will be updated on each click.
Please note HOW i call the functions from on form to the other form. The form name has to be included. The name of the controls have also to match. Its a good idea to rename the controls and forms. I made a autocad VBA with has 1700 controls. Its not the fun after some weeks
to imagine what commandbutton_762 actuelly may do ;)
That can not work like this. You need 3 functions
one to show the userform progressbar 0 percent.
then you need a function to update your form
end finaly the function to remove the form
This code is NOT tested see the testing code i posted here also !
Dim counter As Long
Public Sub UserForm_Activate()
counter = 0
UserForm1.Label2.Width =0
UserForm.show
End Sub
Public Sub UserForm_update()
if counter <100 then counter=counter+1
UserForm1.Label2.Width = counter
DoEvents
end sub
Public Sub UserForm_close()
counter = 0
UserForm.hide
End Sub
'somewhere in a module or class
sub calculate
call UserForm_Activate()
for i=0 to 100
call UserForm_update()
'whatever
' Sleep (200) if this very handy OS call is included somewhere
next
call UserForm_close
end sub
I have built a small 5 minute Countdown in a UserForm.
The countdown should count down. But if the UserForm is closed, the macro should stop and the timer should be reset.
In the UserForm's Terminateevent I have stored the call of my own abort function. This terminates the UserForm, but the timer continues to run in the background and the corresponding macro is always brought to the foreground.
How can the code be modified to stop the timer when the UserForm is closed?
Module 1
Dim Count As Date
Sub callBreak()
Break.Show
End Sub
Sub Time()
Count = Now + TimeValue("00:00:01")
Application.OnTime Count, "minus"
End Sub
Sub minus()
Dim y As Date
y = Break.Label1.Caption
y = y - TimeSerial(0, 0, 1)
Break.Label1.Caption = y
If y <= 0 Then
Break.Label1.Caption = "Arbeit, Arbeit!"
Exit Sub
End If
Call Time
End Sub
Sub abord()
End
End Sub
Userform:
Sub UserForm_Initialize()
Call Coffeebreak.Time
End Sub
Sub UserForm_Terminate()
Call Coffeebreak.abord
End Sub
You can cancel a previously scheduled procedure by setting the optional Schedule argument of Application.OnTime to False. Try this as your Abord() function:
Sub Abord()
Application.OnTime EarliestTime:=Count, Procedure:="minus", Schedule:=False
End Sub
One solution:
in your module, define a global boolean variable, eg isCancelled. Set this variable to true in abort and check it in minus to prevent that the timer is called again.
Dim Count As Date
Dim isCancelled as Boolean
Sub Time()
isCancelled = False
Count = Now + TimeValue("00:00:01")
Application.OnTime Count, "minus"
End Sub
Sub minus()
if isCancelled Then Exit Sub
(...)
End Sub
Sub abort()
isCancelled = True
End Sub
I have this master procedure that calls other procedures. But at two places, I need to check that all values are correct. If they are not, I want this master procedure to quit. What I am trying to do is check the values in my sub procedures and if they are not correct, change exitall to true, which would cause the sub procedure to stop. The thing is, I am fairly certain that if I say in my subprocedure to change the value of of exitall to true, it will not affect my master procedure.
My question is, how do I make the exitall to change in my master procedure, if it is changed in my subprocedure?
Thank you.
Sub Allstepstogether()
Dim r As Integer
Dim exitall As Boolean
Dim answer As Variant
Dim hda As Boolean
Dim wdfh As Variant
hda = False
exitall = False
Call Clean
For Each cell In ThisWorkbook.Sheets("Heyaa").Range("C2:C15")
If Weekday(Date) = vbMonday Then
If CDate(cell.Value) = Date - 3
hda = True
wdfh = cell.Offset(0, 1).Value
End If
Else
If CDate(cell.Value) = Date - 1 Then
hda = True
wdfh = cell.Offset(0, 1).Value
End If
End If
Next cell
Call step4
r = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("BlaCheck").Range("A1:A150"))
If r <> 100 Then
answer = MsgBox("Data not yet uploaded, try again later.", vbOKOnly)
Exit Sub
Else
Call step5
If exitall = True Then
Exit Sub
Else
Call Step7alloptions
Call step8
Call Timetocheck
If exitall = True Then
Exit Sub
Else
Call Step9
Call Step10
Call Step11
End If
End If
End If
end sub
Part of Step5, which should change exitall to true thus stopping the master procedure to be executed if it is incorrect.
sub Step5
dim exitall as boolean
dim lr as integer
'....
'code
'....
lr = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("BlaCheck").Range("A1:A500"))
If lr > 100 Then
answer = MsgBox("Ups, It did not run correctly, this code execution will be terminated", vbOKOnly)
exitall = True
Exit Sub
End If
end sub
Option 1 is to declare exitall with global scope:
Dim exitall As Boolean '<--Add this at the top of the module.
Sub Allstepstogether()
Dim r As Integer
'Dim exitall As Boolean '<--Remove this from all your Subs.
Better would be to change your Subs into Functions that return a Boolean for success and just test for that. Note that you also don't have to use Else after an If condition that exits - that should cut down your indentation level dramatically:
Converted Sub:
Function Step5() As Boolean
Dim lr As Integer
'....
'code
'....
lr = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("BlaCheck").Range("A1:A500"))
If lr > 100 Then
answer = MsgBox("Ups, It did not run correctly, this code execution will be terminated", vbOKOnly)
Exit Function
End If
Step5 = True
End Function
Calling code:
Sub Allstepstogether()
'[Snip]
r = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("BlaCheck").Range("A1:A150"))
If r <> 100 Then
answer = MsgBox("Data not yet uploaded, try again later.", vbOKOnly)
Exit Sub
End If
If Not Step5 Then Exit Sub
Step7alloptions
step8
If Not Timetocheck Then Exit Sub
Step9
Step10
Step11
End Sub