I have 3 toggle buttons as shown in Excel VBA. First I press continuous then it will be pressed and start running macro. During that if I need to press Emergency button I need to do :
step1: Switch off Continuous button
step2 : Switch on Emergency Button
( manual is irrelevent here)
Currently when I try to do this, Emergency Stop cannot be pressed until macro of continuous ends.
I use this most of the time when I trying to say, scrape data from the net.
Option Explicit
Dim boolStop As Boolean
'~~> Continuous button
Private Sub CommandButton1_Click()
CommandButton1.Enabled = False
boolStop = False
For i = 1 To 1000000000
For j = 1 To 1000000000
Debug.Print i
DoEvents
If boolStop = True Then
Msgbox "Operation Paused by the User"
CommandButton1.Enabled = True
Exit Sub
End If
Next j
Next i
End Sub
'~~> Emergency button
Private Sub CommandButton3_Click()
boolStop = True
End Sub
Related
I'm a noob in excel VBA so please do understand.
I am tasked to input employee total working time into a worksheet efficiently to minimize human error. So there is three option, normal working time is 490 minutes, over time is 640 minutes and user input option as sometimes the employee do not work for 490 or 640 minutes.
So I've created a userform, in my userform, i have input 2 option button for the normal working time and over time. I have also input a textbox for the third option to the user to input a specific working time.
Therefore, I wanted to open up the userform when click on a cell instead of a button. And input the data from the userform into the selected cell. I'm able to open up the userform by clicking on the cell, using this code
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("H10:I29")) Is Nothing Then
UserForm1.Show
End If
End Sub
My issues is I do not know how to input the data from the userform into the selected cell.
Any help is appreciated. Thanks.
Let say you have, in your UserForm1:
Button1, which applies 1st value into selected cell
Button2, which applies 2nd value into selected cell
TextBox1, where you write an uncommon value
Button3, which applies value from TextBox1 into selected cell
In UserForm1 code you put:
Private Sub Button1_Click()
Selection.Value = 490
End Sub
Private Sub Button2_Click()
Selection.Value = 640
End Sub
Private Sub Button3_Click()
Selection.Value = TextBox1.Value
End Sub
Assuming:
normal time OptionButton named after "NormalTime_OB"
over time OptionButton named after "OverTime_OB"
specific time TextBox named after "SpecificTime_TB"
ok Button named after "Ok_Btn"
you may try the following code in your userform code pane:
Option Explicit
Private Sub Ok_Btn_Click()
Const NORMALHOURS As Long = 490
Const OVERTIMEHOURS As Long = 640
Dim hours As Long
With Me
Select Case True
Case .NormalTime_OB
hours = NORMALHOURS
Case .OverTime_OB
hours = OVERTIMEHOURS
Case Else
hours = GetTextBoxInpt(.SpecificTime_TB)
End Select
If hours > 0 Then
ActiveCell.Value = hours
.Hide
End If
End With
End Sub
Function GetTextBoxInpt(TB As MSForms.TextBox)
Const MINHOURS As Long = 490 '<--| change it to your needs
Const MAXHOURS As Long = 640 '<--| change it to your needs
Dim hours As Long
With TB
If IsNumeric(.text) Then
hours = CLng(.text)
If hours <= MINHOURS Or hours > MAXHOURS Then
MsgBox "You must enter a value between " & MINHOURS & " and " & MAXHOURS, vbExclamation, "Working Time input"
Else
GetTextBoxInpt = hours
Exit Function
End If
Else
MsgBox "You must enter a numeric value", vbExclamation, "Working Time input"
End If
.text = ""
End With
End Function
while your worksheet event handler becomes:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("H10:I29")) Is Nothing Then
UserForm1.Show
Unload UserForm1
End If
End Sub
I have a form that appears on a double click event of a specific cell.
The form contains a list box with a bunch of checkboxes in it and in my _Activate() sub, the checkboxes are set to true or false based on values on the active sheet.
The trouble is that when the form opens up behind the cursor, the second click of the double click that opens the form is also checking/unchecking a checkbox in the form.
I've tried sticking "DoEvents" in the activate sub before the code sets the checkbox values but it hasn't made a difference - The checkbox behind my cursor where the form opens will be checked/unchecked.
I don't expect that the code will help much but it is essentially as below:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target = Range("aParticularRangeName") Then
frmSelectStuff.Show
End If
End Sub
Public Sub UserForm_Activate()
Dim iRegions As Integer
Dim sRecheck As Variant
Dim sRecheckList() As String
sRecheckList = Split(ActiveCell.Value, "; ")
For Each sRecheck In sRecheckList
For iRegions = 0 To lbRegionsTemp.ListCount - 1
If sRecheck = lbRegionsTemp.List(iRegions) Then lbRegionsTemp.Selected(iRegions) = True
Next
Next
End Sub
What about using Cancel = True?
If Target = Range("aParticularRangeName") Then
Cancel = True
frmSelectStuff.Show
End If
How can you pause a code from running and then allow it to continue again.
Using a ToggleButton in a Userform (which initiates your code and Modal = True)
You can successfully pause the code. With this you can then work in an additional selection to change the operation or function of the code via an addiotn button.
You will need to use public/global variables.
Comments Welcome.
Userform:
Public Sub ToggleButton1_AfterUpdate()
'Program is Paused / Selected to Pause
If ProgBar.ToggleButton1.Value = True Then
'Changing the Text of the Toggle button once the program is
'selected to Pause
'If program paused then button will display continue
ProgBar.ToggleButton1.Caption = "Continue"
'For Sending to Loop Code
ProgramStatus = "0"
Call LoopCode.PrgStat(ProgramStatus)
End If
'Program is running / Selected to run
If ProgBar.ToggleButton1.Value = False Then
'Changing the Text of the Toggle button once the program is selected to continue
'If program running then button will display pause
ProgBar.ToggleButton1.Caption = "Pause"
'For Sending to Loop Code
ProgramStatus = "1"
Call LoopCode.PrgStat(ProgramStatus)
End If
End Sub
In your Module
Public Status As String
Public Sub PrgStat(ByVal ProgStatus As String)
Status = ProgStatus
End Sub
Sub SomeSub()
Do While
' Some Loop Code Running
If Status = "1" Then
'Toggle Not Pressed
End If
If Status = "0" Then
'Toggle Button Pressed
Do While Status = "0"
'Program will stop here until the togglebutton on the
'userform is pressed again which changes Status = 1
'This is where you can make another selection on the
'userform
DoEvents
Loop
End If
Loop
End Sub
I've got a code in a dropdown box on my userform. Every time the user moves away from the drop down box, the code checks whether the value put by the user is correct (i.e. matches a list). If it doesn't, it triggers a message box. Here is my code:
Private Sub CmboxModifyRoute_Exit(ByVal Cancel As MSForms.ReturnBoolean)
UserValue = CmboxModifyRoute.Value
counter = 0
Cell = Range("C15").Value
If UserValue = "" Then Exit Sub
Do While (counter < 35 And Cell <> UserValue) 'checking if UserValue is valid
counter = counter + 1
Cell = Range("C15").Offset(counter, 0).Value
Loop
If counter > 34 Then 'if invalid, then display message box
MsgBox "Invalid", vbExclamation
End If
End Sub
The problem occurs when I quit the userform with the "X" button or "Cancel" button. If the UserValue is invalid, it still shows me the "Invalid" message box after I have already quit the userform. I don't want it, I just want the userform to unload. How can I deal with this? Many thanks!
Change your condition to this:
If Me.Visible And counter > 34 Then
MsgBox "Invalid", vbExclamation
End If
Then the message will not be displayed if the form isn't visible.
Data Validation should go in the BeforeUpdate event of the combo box. Before Update won't trigger prior to the User Form's Terminate event. Add UserForm_Terminate and CmboxModifyRoute_BeforeUpdate events to your code, set breakpoints on the declaration of each, and watch the order of events happen in debug mode.
Private Sub CmboxModifyRoute_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'data validation goes here
'doesn't fire when the form is closed
End Sub
Private Sub CmboxModifyRoute_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'this triggers before Terminate
End Sub
Private Sub UserForm_Terminate()
End Sub
I would like to handle single click and double click events separately for an ActiveX button in VBA. My issue is that the single click event is called for both single and double clicks. Is there a way to supress/bypass the single click procedure when a double click event occurs? I'm sure there's a simple answer for this, but can't find anything on the web...
From Help
If there is code in the Click event, the DblClick event will never trigger, because the Click event is the first event to trigger between the two. As a result, the mouse click is intercepted by the Click event, so the DblClick event doesn't occur.
Try capturing Mouse Down and Mouse Up, wait 500 ms, if no Mouse Down, then it's a single click, if there is wait the time for a mouse down.
DoubleClickSpeed
HKCU\Control Panel\Mouse
Data type Range Default value
REG_SZ 100 - 900 (milliseconds in decimal) 500
Brad Yundt provides this clever workaround at Experts-Exchange in this post.
I have assumed you have asked this wrt Excel- pls let me know if I am mistaken
You might try using Application.OnTime to schedule a response to a
leftclick after say a 1 second delay. If a doubleclick or rightclick
occurs in the meantime, then the leftclick event in the OnTime sub
will not occur.
The following code goes in the code pane for the worksheet being watched. Note that it uses the code name for that worksheet, not the tab name.
As written, the code watches A1:A10 for either a leftclick, rightclick or doubleclick on a single cell. It then displays a message box naming the cell that was clicked and the type of click.
worksheet event code
Dim bTrapped As Boolean
Dim cel As Range, rgWatch As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(cel, Target) Is Nothing Then
MsgBox "Doubleclick at " & cel.Address
bTrapped = True
Cancel = True
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(cel, Target) Is Nothing Then
MsgBox "Rightclick at " & cel.Address
bTrapped = True
Cancel = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim targ As Range
Set rgWatch = Range("A1:A10")
Set targ = Intersect(Target, rgWatch)
If Not targ Is Nothing Then
If targ.Cells.Count = 1 Then
bTrapped = False
Set cel = targ.Cells(1, 1)
'Allow 1 second for user to complete a rightclick or doubleclick before trapping leftclick
Application.OnTime Now + 1 / 86400, "Sheet1.DelayedWatch" 'Note that Sheet1 is codename for worksheet (not tabname)
End If
End If
End Sub
Private Sub DelayedWatch()
If bTrapped = False Then
MsgBox "Leftclick at " & cel.Address
End If
End Sub
I know this reply is years late but to cancel an event, so as to prevent another event happening (on the same event) (ie. prevent single click for happening when you act on the double click) do the following;
Private Sub CheckBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Do your stuff in here to handle the doubleClick event
Cancel = True 'send back a true boolean to cancel the singleClick
End Sub