I'm trying to realise a text delay input in Excel.
User need to get some data from stream scanner.
If user is scanning again in 3 seconds, Excel need to clear current cell and do not move cursor on next cell.
This is my code:
Public oldtime As Date
Public nowtime As Date
Private Sub Worksheet_Change(ByVal Target As Range)
nowtime = Now
Application.EnableEvents = False
If (nowtime - oldtime) > 0.0003 Then
oldtime = Now
Else
ActiveCell.Value = ""
End If
Application.EnableEvents = True
End Sub
The problem is that it doesn't work normally. Some times it is clearing cell, but mostly of all - not.
Please, could you help me?
No way to test with the scanner but try this:
Option Explicit
Public oldtime As Variant
'Public nowtime As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If (Timer - oldtime) > 3 Then
oldtime = Timer
Else
Target.Value = ""
Target.Select
End If
End Sub
Is this what your're trying?
Related
I have a Worksheet in excel 2013, with 25 activex buttons on it. depending on a cell value for each button, i would like it to be visible or hidden. In my case the value of cell U6 makes my commandbutton1 visible, U7 would make commandButton2 visible.... Only my CommandButton1 works properly. I have tried different combinations of code without succes.
Private Sub CommandButton1_Click()
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'ActiveX button1
If Range("U6") = 1 Then
Sheets("Feuil1").CommandButton1.Visible = True
Else
Sheets("Feuil1").CommandButton1.Visible = False
End If
End Sub
If Range("U6") = 1 Then
Shouldn't that check if the Target (i.e. the modified cell) is in column U?
Sheets("Feuil1").CommandButton1.Visible = True
That road leads to pastaland, you don't want to go there: extract a method. You'll want to query the OLEObjects collections to get the ActiveX control by name, rather than hard-coding the button names 25+ times.
Private Sub SetControlVisibility(ByVal controlName As String, ByVal isVisible As Boolean)
Dim axControl As OLEObject
On Error Resume Next 'next statement may throw error #9
Set axControl = Me.OLEObjects(controlName)
If axControl Is Nothing Then Exit Sub
On Error GoTo 0 'restore error handling
axControl.Object.Visible = isVisible
End Sub
Now you have a method that can toggle the visibility of any ActiveX control on the sheet, given its name.
So in the Worksheet_Change handler, you now just need to work out the name of the ActiveX control, and whether or not you want it visible:
Private Sub Worksheet_Change(ByVal Target As Range)
'bail out if the modified cell isn't interesting, or if it's more than 1 cell:
If Intersect(Target, Me.Range("U6:U31") Is Nothing Or Target.Count <> 1 Then Exit Sub
Dim buttonName As String
buttonName = "CommandButton" & Target.Row - 5
Dim isVisible As Boolean
isVisible = Target.Value = 1
SetControlVisibility buttonName, isVisible
End Sub
Or something like it. Note: code written in the answer box, untested & for illustrative purposes only. Copy-pasta at your own risk.
Recently I've managed to find some code regarding a timer on a userform, my problem is that I need to keep the timer running even if the userform or excel file is closed... can someone take a look at the code and provide some feedback? My userform is: optionsForm
Dim dteStart As Date, dteFinish As Date
Dim dteStopped As Date, dteElapsed As Date
Dim boolStopPressed As Boolean, boolResetPressed As Boolean
Private Sub Reset_Timer_Click()
dteStopped = 0
dteStart = 0
dteElapsed = 0
Tech_Timer = "00:00:00"
boolResetPressed = True
End Sub
Private Sub Start_Timer_Click()
Start_Timer:
dteStart = Time
boolStopPressed = False
boolResetPressed = False
Timer_Loop:
DoEvents
dteFinish = Time
dteElapsed = dteFinish - dteStart + dteStopped
If Not boolStopPressed = True Then
Tech_Timer = dteElapsed
If boolResetPressed = True Then GoTo Start_Timer
GoTo Timer_Loop
Else
Exit Sub
End If
End Sub
Private Sub Stop_Timer_Click()
boolStopPressed = True
dteStopped = dteElapsed
End Sub
Private Sub optionsForm_Initialize()
Tech_Timer = "00:00:00"
End Sub
The idea of the timer is not that it runs, but that it remembers a point in time and can give you a difference between this point and the current moment. If you ask for this difference every second, then it would look like it is running like a watch.
Something like this would be a good start. In the xl_main write the following:
Option Explicit
Dim dtime As Date
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cells(1, 1).Value = dtime
End Sub
Private Sub Workbook_Open()
If Cells(1, 1).Value = 0 Then
dtime = Now
Else
dtime = CDate(Cells(1, 1))
End If
End Sub
You may play around it and make it better as you wish. E.g. you may find a way to reset dtime or anything similar.
"Something" needs to be running to handle the timer procedure so if you want to use VBA then Excel can't be "closed" per se, however you could make it appear closed.
An obvious option is to minimize the Excel window (before showing the userform) with the WindowState property:
Application.WindowState = xlMinimized
...or, hide the Excel window completely with the Visible property:
Application.Visible = False
...or if the issue is that you need a "fresh" copy of Excel to work in, you could do so in a new instance by holding Alt while starting Excel.
I have posted code and a downloadable example of a countdown timer that displays the time remaining on a userform semi-independent of the Excel window, using the Windows Timer API (instead of Excel's procedure), in another answer here.
That's not possible if the form is unloaded Unload optionsForm. But you can try to 'close' the form with optionsForm.hide() this only hides the form, the timer should keep running then.
The only way I see to calculate the time passed from a start time even if Excel is closed is to not save the start time in a variable dteStart but in an Excel cell.
Actually you can use a code that is placed in a module. The code is:
Option Explicit
Dim T
Sub stopTimer()
On Error Resume Next
Application.OnTime (T), Procedure:="Update", Schedule:=False
End Sub
Sub StartTimer()
T = Now + TimeValue("00:00:01")
Application.OnTime T, "Update"
End Sub
Sub Update()
UserForm1.TextBox1.Value = Format(Now - Sheets("Sheet1").Range("E11").Value,
"hh:mm:ss")
UserForm1.TextBox2.Value = Format(TimeValue("1:00:00") - (Now -
Sheets("Sheet1").Range("E11").Value), "hh:mm:ss")
Call StartTimer
End Sub
Thereafter, you can now reference it in the userform by calling it. Here is a typical example. It is
Private Sub Userform_Activate()
Sheet1.Activate
Sheets("Sheet1").Range("E11").Value = Now
Application.Run "StartTimer"
If Sheets("Sheet1").Range("K27").Value = "K29" Then
Me.CommandButton4.Caption = "Start"
Me.CommandButton2.Visible = False
End If
End Sub
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
Purpose: Click on a cell in a range (Range: Column K:K on excel worksheet). Once you click on a specific cell in column K, userform pops up with cell value using following code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
Credit_Information.TextBox1.Value = Target.Value
Credit_Information.Show
End If
End Sub
My question, is depending on where I click on column K, I want to use two buttons on my userform (Previous and Next) to move up and down column K and see the values of the cell dynamically change on my userform. Is this possible? Please let me know if any clarification is needed.
Just add the two command buttons to your userform.
Name one of the buttons cmdNext and give it a caption of "Next".
Name the other button cmdPrev and give it a caption of "Previous".
Then, in the userform code module, place these routines:
Private Sub cmdNext_Click()
ActiveCell(2).Select
End Sub
Private Sub cmdPrev_Click()
If ActiveCell.Row > 1 Then ActiveCell(0).Select
End Sub
That's it.
Note: if you want you can add code to ensure that the ActiveCell is in column K before allowing the new selections:
If ActiveCell.Column = 11 Then ...
Perfect, Thanks!
I also found out that using Offset worked for me too in this manner. I'm not sure however if I'm breaking any conventions by doing this.
Private Sub CommandButton1_Click()
ActiveCell.Offset(-1).Activate
End Sub
Private Sub CommandButton2_Click()
ActiveCell.Offset(1).Activate
End Sub
It is possible, but I would create another procedure for that. What you could do is declare a public variable in your userform & set it equal to the range Target. Then you could call another procedure from the userform on each button click and redefine the selected range after each click.
So, at the top of your userform do this:
Public selected_cell as Range
Then for the up button:
Private Sub ButtonUp.Click()
If selected_cell.Row < 2 Then Exit Sub
selected_cell.Rows(0).Select
Set selected_cell = selected_cell.Rows(0)
me.TextBox1.Value = selected_cell
End Sub
And the down button would be:
Private Sub ButtonDown.Click()
selected_cell.Rows(2).Select
Set selected_cell = selected_cell.Rows(2)
me.TextBox1.Value = selected_cell
End Sub
Now let's make your code like this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
With Credit_Information
Set .selected_cell = target
.TextBox1.Value = Target.Value
.Show
End With
End If
End Sub
I have a Excel workbook calculator dependent on a few parameters. I want the client to be able to insert those parameters into an appropriate "client input" cell on every spreadsheet so he doesn't have to jump back and forth between spreadsheets.
Is there a good way to do it? I tried the following scheme, but it's buggy for reasons unknown to me:
make a VBA module declaring variables to hold my parameters
initialize them with appropriate initial values on the Workbook_Open event
make the specific sheets write those values into "client input" cells on Worksheet_Activate event
in a Worksheet_Deactivate event, if the "client input" cells are different among each other - update the VBA variables
This works sometimes, but not always. Is there a better way to do this?
EDIT:
This is my "GM" Module:
Option Explicit
Public perspective As String
Public RSS As String
Public Payback As Double
This is my "ThisWorkbook:
Private Sub Workbook_Open()
GM.perspective = Worksheets("Hidden variables").Range("A1").Value
GM.RSS = Worksheets("Hidden variables").Range("B2").Value
GM.Payback = Worksheets("Hidden variables").Range("C3").Value
End Sub
Private Sub Workbook_Close()
Worksheets("Hidden variables").Range("A1") = GM.perspective
Worksheets("Hidden variables").Range("B2") = GM.RSS
Worksheets("Hidden variables").Range("C3") = GM.Payback
End Sub
This is in my worksheet 1 (in worksheet 2 there is an analogous code):
Option Explicit
Private Sub Worksheet_Activate()
'SIMULTANEOUS UPDATE p.1
Worksheets("1").Range("I32") = GM.Payback
Worksheets("1").Range("I29") = GM.RSS
Worksheets("1").Range("I26") = GM.perspective
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'BASIC PRICE CALCULATION
If Target.Count > 1 Then Exit Sub
If Target = Range("I32") _
Or Target = Range("I29") _
Or Target = Range("I26") _
Or Target = Worksheets("Intro").Range("price") _
Then
Worksheets("Hidden variables").Range("condition") = 2
Worksheets("Hidden variables").Range("basic_price") = Worksheets("Intro").Range("price").Value
Range("M44").GoalSeek Goal:=0, ChangingCell:=Worksheets("Hidden variables").Range("basic_price")
If Worksheets("Hidden variables").Range("basic_price").Value < 0 Then
Range("M46") = "Error"
Else
Range("M46") = Worksheets("Hidden variables").Range("basic_price").Value
End If
Worksheets("Hidden variables").Range("condition") = 1
End If
End Sub
Private Sub Worksheet_Deactivate()
'SIMULTANEOUS UPDATE p.2
GM.Payback = Worksheets("1").Range("I32").Value
GM.RSS = Worksheets("1").Range("I29").Value
GM.perspective = Worksheets("1").Range("I26").Value
End Sub
To avoid infinite loop, you can use a global variable
Outside a function (at the begin of your module)
Public isUpdating As Double
inside your Worksheet_change
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if an update is in progress. If so, exit the change
if isUpdating then
exit sub
end if
' Begin of the update
isUpdating = true
' Here your update
' End of the update
isUpdating = false
End sub