I have created a userform where the user has to put in some time values, these time values are for example how long a product has to be processed for. I have a code that is almost what I would like it to do, only when it reaches 24 hours, it resets to 0. but the input requires to be for 24+ hours (for example: 36:59:59 (where the max value of mm & ss = 59, the hh max value should be 99).
could anyone assist me on how I can change this?
Private mtmPosition1 As tmPosition1
Private Const msFMTTIME1 As String = "[$-409]hh:mm:ss"
Private Const miRIGHTARROW1 As Integer = 39
Private Const miLEFTARROW1 As Integer = 37
Private Const mdHOUR1 As Double = 1 / 24
Private Const mdMINUTE1 As Double = 1 / 24 / 60
Private Const mdSECOND1 As Double = 1 / 24 / 60 / 60
Private Enum tmPosition1
tmPositionHour1
tmPositionMinute1
tmPositionSecond1
End Enum
Private Sub sbTime1_SpinDown()
If Me.IsHour1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) - mdHOUR1, msFMTTIME1)
SelectHour1
ElseIf Me.IsMinute1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) - mdMINUTE1, msFMTTIME1)
SelectMinute1
ElseIf Me.IsSecond1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) - mdSECOND1, msFMTTIME1)
SelectSecond1
End If
End Sub
Private Sub sbTime1_SpinUp()
If Me.IsHour1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) + mdHOUR1, msFMTTIME1)
SelectHour1
ElseIf Me.IsMinute1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) + mdMINUTE1, msFMTTIME1)
SelectMinute1
ElseIf Me.IsSecond1 Then
Me.tbxTimePicker1.Text = Format(1 + TimeValue(Me.tbxTimePicker1.Text) + mdSECOND1, msFMTTIME1)
SelectSecond1
End If
End Sub
Private Sub tbxTimePicker1_Enter()
With Me.tbxTimePicker1
.SelStart = 0
.SelLength = 2
End With
mtmPosition1 = tmPositionHour1
End Sub
Private Sub tbxTimePicker1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = miRIGHTARROW1 Then
If Me.IsHour1 Then
SelectMinute1
ElseIf Me.IsMinute1 Then
SelectSecond1
End If
ElseIf KeyCode = miLEFTARROW1 Then
If Me.IsSecond1 Then
SelectMinute1
Else
SelectHour1
End If
Else
If Me.IsHour1 Then
SelectHour1
ElseIf Me.IsMinute1 Then
SelectMinute1
ElseIf Me.IsSecond1 Then
SelectSecond1
End If
End If
End Sub
Private Sub tbxTimePicker1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Me.tbxTimePicker1.SelStart < 3 Then
SelectHour1
ElseIf Me.tbxTimePicker1.SelStart < 6 Then
SelectMinute1
ElseIf Me.tbxTimePicker1.SelStart < 9 Then
SelectSecond1
End If
End Sub
Public Property Get IsHour1() As Boolean
IsHour1 = mtmPosition1 = tmPositionHour1
End Property
Public Property Get IsMinute1() As Boolean
IsMinute1 = mtmPosition1 = tmPositionMinute1
End Property
Public Property Get IsSecond1() As Boolean
IsSecond1 = mtmPosition1 = tmPositionSecond1
End Property
Private Sub SelectMinute1()
With Me.tbxTimePicker1
.SetFocus
.SelStart = 3
.SelLength = 2
End With
mtmPosition1 = tmPositionMinute1
End Sub
Private Sub SelectHour1()
With Me.tbxTimePicker1
.SetFocus
.SelStart = 0
.SelLength = 2
End With
mtmPosition1 = tmPositionHour1
End Sub
Private Sub SelectSecond1()
With Me.tbxTimePicker1
.SetFocus
.SelStart = 6
.SelLength = 2
End With
mtmPosition1 = tmPositionSecond1
End Sub
Without trying to modify your code, I suggest to do as follows:
Let the user enter, with SpinDown and SpinUp controls the "process duration" as three numbers (integers), 0-99 (hours), 0-59 (minutes) and 0-59 (seconds). Do not treat these as time values, just simple numbers.
If applicable, let the user enter "process start time", use separate SpinDown/SpinUp controls as true time values.
If applicable, to show "process end time" use simple text boxes to show start time + duration as calculated end time (day, hour, minute, second)
Related
I have Userform using Textbox to input date.
I'd like to show suggestion text before input like __ /__/____ (same format dd/mm/yyyy)
When enter this Textbox, cursor always in beginning. When I typing, each _ symbol will be replaced by number, and skip / symbol.
For example: I just type 05041991, in Textbox will show 05/04/1991.
Please help me about this code.
You could do something like shown below. This code is just an example (probably not perfect).
Image 1: Note that only number keys and backspace were pressed.
Put the following code into a class module and name it MaskedTextBox
Option Explicit
Public WithEvents mTextBox As MSForms.TextBox
Private mMask As String
Private mMaskPlaceholder As String
Private mMaskSeparator As String
Public Enum AllowedKeysEnum
NumberKeys = 1 '2^0
CharacterKeys = 2 '2^1
'for more options next values need to be 2^2, 2^3, 2^4, …
End Enum
Private mAllowedKeys As AllowedKeysEnum
Public Sub SetMask(ByVal Mask As String, ByVal MaskPlaceholder As String, ByVal MaskSeparator As String, Optional ByVal AllowedKeys As AllowedKeysEnum = NumberKeys)
mMask = Mask
mMaskPlaceholder = MaskPlaceholder
mMaskSeparator = MaskSeparator
mAllowedKeys = AllowedKeys
mTextBox.Text = mMask
FixSelection
End Sub
' move selection so separators get not replaced
Private Sub FixSelection()
With mTextBox
Dim Sel As Long
Sel = InStr(1, .Text, mMaskPlaceholder) - 1
If Sel >= 0 Then
.SelStart = Sel
.SelLength = 1
End If
End With
End Sub
Private Sub mTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim tb As MSForms.TextBox
Set tb = Me.mTextBox
'allow paste
If Shift = 2 And KeyCode = vbKeyV Then
On Error Resume Next
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
Dim PasteData As String
PasteData = DataObj.GetText(1)
On Error GoTo 0
If PasteData <> vbNullString Then
Dim LikeMask As String
LikeMask = Replace$(mMask, mMaskPlaceholder, "?")
If PasteData Like LikeMask Then
mTextBox = PasteData
End If
End If
End If
Select Case KeyCode
Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9
'allow number keys
If Not (mAllowedKeys And NumberKeys) = NumberKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If
Case vbKeyA To vbKeyZ
'allow character keys
If Not (mAllowedKeys And CharacterKeys) = CharacterKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If
Case vbKeyBack
'allow backspace key
KeyCode = 0
If tb.SelStart > 0 Then 'only if not first character
If Mid$(tb.Text, tb.SelStart, 1) = mMaskSeparator Then
'jump over separators
tb.SelStart = tb.SelStart - 1
End If
'remove character left of selection and fill in mask
If tb.SelLength <= 1 Then
tb.Text = Left$(tb.Text, tb.SelStart - 1) & Mid$(mMask, tb.SelStart, 1) & Right$(tb.Text, Len(tb.Text) - tb.SelStart)
End If
End If
'if whole value is selected replace with mask
If tb.SelLength = Len(mMask) Then tb.Text = mMask
Case vbKeyReturn, vbKeyTab, vbKeyEscape
'allow these keys
Case Else
'disallow any other key
KeyCode = 0
End Select
FixSelection
End Sub
Private Sub mTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
FixSelection
End Sub
Put the following code into your userform
Option Explicit
Private MaskedTextBoxes As Collection
Private Sub UserForm_Initialize()
Set MaskedTextBoxes = New Collection
Dim MaskedTextBox As MaskedTextBox
'init TextBox1 as date textbox
Set MaskedTextBox = New MaskedTextBox
Set MaskedTextBox.mTextBox = Me.TextBox1
MaskedTextBox.SetMask Mask:="__/__/____", MaskPlaceholder:="_", MaskSeparator:="/"
MaskedTextBoxes.Add MaskedTextBox
'init TextBox2 as barcode textbox
Set MaskedTextBox = New MaskedTextBox
Set MaskedTextBox.mTextBox = Me.TextBox2
MaskedTextBox.SetMask Mask:="____-____-____", MaskPlaceholder:="_", MaskSeparator:="-", AllowedKeys:=CharacterKeys + NumberKeys
MaskedTextBoxes.Add MaskedTextBox
End Sub
I know that we can use function Date in forms for the insertion of the date. But for some dates (such as Hijri Shamsi and Hijri lunar history, etc.), this is impossible and difficult. So I wrote a code that works with the text box. But I think the code that I wrote can be simpler. Do you have a solution to make it simpler?
For example: checking the slash or preventing of Double message display for the moon and day error.
Thanks in advance for the friends who respond.
Private Sub TextBox1_Change()
'To check the slash in the correct place
If Mid(TextBox1, 1) = "/" Or Mid(TextBox1, 2) = "/" Or Mid(TextBox1, 3) = "/" Or Mid(TextBox1, 4) = "/" Or Mid(TextBox1, 6) = "/" Or Mid(TextBox1, 7) = "/" Or Mid(TextBox1, 9) = "/" Or Mid(TextBox1, 10) = "/" Then
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
SendKeys ("{BACKSPACE}")
End If
'Insert the slash automatically
If TextBox1.TextLength = 8 Then
Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
End If
'Year Error!
If Mid(TextBox1, 4) = 0 Then
MsgBox "Year Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
With TextBox1
.SelStart = 0
.SelLength = Len(.Text)
End With
Exit Sub
End If
'Month Error!
If TextBox1.TextLength = 10 Then
If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then
MsgBox "Month Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
With TextBox1
.SelStart = 5
.SelLength = 2
'.SelText = ""
End With
Exit Sub
End If
End If
'Day Error!
If TextBox1.TextLength = 10 Then
If Mid(TextBox1.Value, 9, 2) = 0 Or Mid(TextBox1.Value, 9, 2) > 31 Then
MsgBox "Day Error!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
With TextBox1
.SelStart = 8
.SelLength = 2
End With
Exit Sub
End If
End If
End Sub
Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Accept only number and slash
If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
KeyAscii = 0
MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
With TextBox1
.SetFocus
Exit Sub
End With
End If
End Sub
I am not familiar enough with the calendar forms you're dealing with, so please understand my example based on a western-style calendar.
The way you're performing some of your error checking somewhat obscures the values you'e checking. For example,
If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then
is a perfectly valid check, but you're overusing the Mid function. One suggestion is to parse the date string and pull out substrings into values you're looking for. As in:
Dim month As Long
month = CLng(Mid$(TextBox1.Value, 6, 2))
If (month = 0) Or (month > 12) Then
this makes more intuitive sense. Yes, it creates an extra variable, but it makes your code much more readable.
Here's my (untested) version of your code as another example of how it can be done. Notice that I'm separating the error checking into a separate function because it's more involved. (This way it isn't cluttering the main routine.)
EDIT: Answer has been updated and tested. Changed the event code from TextBox1_Change and now catching two different events: LostFocus and KeyDown in order to kick off a validation when the user clicks away from the textbox or types Enter while in the textbox.
Option Explicit
Private Enum ValidationError
LengthError
FormatError
YearError
MonthError
DayError
NoErrors
End Enum
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = Asc(vbCr) Then
ValidateDate
End If
End Sub
Private Sub TextBox1_LostFocus()
ValidateDate
End Sub
Private Sub ValidateDate()
With TextBox1
Select Case InputIsValidated(.text)
Case LengthError
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
Case FormatError
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
Case YearError
.SelStart = 0
.SelLength = 4
MsgBox "Invalid Year. Must be between 2015 and 2020"
Case MonthError
.SelStart = 5
.SelLength = 2
MsgBox "Invalid Month. Must be between 1 and 12"
Case DayError
.SelStart = 7
.SelLength = 2
MsgBox "Invalid Day. Must be between 1 and 31"
Case NoErrors
'--- nothing to do, it's good!
MsgBox "It's good!"
End Select
End With
End Sub
Private Function InputIsValidated(ByRef text As String) As ValidationError
'--- perform all sorts of checks to validate the input
' before any processing
'--- MUST be the correct length
If (Len(text) <> 8) And (Len(text) <> 10) Then
InputIsValidated = LengthError
Exit Function
End If
'--- check if all characters are numbers
Dim onlyNumbers As String
onlyNumbers = Replace(text, "/", "")
If Not IsNumeric(onlyNumbers) Then
InputIsValidated = FormatError
Exit Function
End If
Dim yyyy As Long
Dim mm As Long
Dim dd As Long
yyyy = Left$(onlyNumbers, 4)
mm = Mid$(onlyNumbers, 5, 2)
dd = Right$(onlyNumbers, 2)
'--- only checks if the numbers are in range
' you can make this more involved if you want to check
' if, for example, the day for February is between 1-28
If (yyyy < 2015) Or (yyyy > 2020) Then
InputIsValidated = YearError
Exit Function
End If
If (mm < 1) Or (mm > 12) Then
InputIsValidated = MonthError
Exit Function
End If
If (dd < 1) Or (dd > 31) Then
InputIsValidated = DayError
Exit Function
End If
text = onlyNumbers
InputIsValidated = NoErrors
End Function
Thanks to #PeterT, I corrected the code with guidance #PeterT and I give it to all the interested people. Enjoy it.
Option Explicit
Private Enum ValidationError
LengthError
FormatError
YearError
MonthError
DayError
NoErrors
End Enum
Private Sub TextBox1_Change()
'To check the slash in the correct place
If TextBox1.TextLength = 10 Then
If InStr(Left(TextBox1, 4), "/") Or InStr(Mid(TextBox1, 6, 2), "/") Or InStr(Mid(TextBox1, 9, 2), "/") <> 0 Then
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
With TextBox1
.SelStart = 0
.SelLength = Len(.text)
End With
End If
End If
'Insert the slash automatically
If TextBox1.TextLength = 8 Then
If InStr(TextBox1, "/") Then
'nothing
Else
Me.TextBox1.Value = Format(Me.TextBox1.Value, "0000/00/00")
End If
End If
End Sub
Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'Accept only number and slash
If Not Chr(KeyAscii) Like "[0-9,/ ]" Then
KeyAscii = 0
MsgBox "Only Numbers Allowed!" & vbNewLine & "Please insert date with format: YYYYMMDD or YYYY/MM/DD"
End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = Asc(vbCr) Then
ValidateDate
End If
End Sub
Private Sub TextBox1_LostFocus()
ValidateDate
End Sub
Private Sub ValidateDate()
With TextBox1
Select Case InputIsValidated(.text)
Case LengthError
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
Case FormatError
MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
Case YearError
.SelStart = 0
.SelLength = 4
MsgBox "Invalid Year. Must be between 2015 and 2020"
Case MonthError
.SelStart = 5
.SelLength = 2
MsgBox "Invalid Month. Must be between 1 and 12"
Case DayError
.SelStart = 8
.SelLength = 2
MsgBox "Invalid Day. Must be between 1 and 31"
Case NoErrors
'--- nothing to do, it's good!
MsgBox "It's good!"
End Select
End With
End Sub
Private Function InputIsValidated(ByRef text As String) As ValidationError
'--- perform all sorts of checks to validate the input
' before any processing
'--- MUST be the correct length
If InStr(TextBox1, "/") And TextBox1.TextLength < 10 Then
InputIsValidated = FormatError
Exit Function
End If
Dim yyyy As Long
Dim mm As Long
Dim dd As Long
yyyy = Left$(TextBox1, 4)
mm = Mid$(TextBox1, 6, 2)
dd = Right$(TextBox1, 2)
'--- only checks if the numbers are in range
' you can make this more involved if you want to check
' if, for example, the day for February is between 1-28
If (yyyy < 2015) Or (yyyy > 2020) Then
InputIsValidated = YearError
Exit Function
End If
If (mm < 1) Or (mm > 12) Then
InputIsValidated = MonthError
Exit Function
End If
If (dd < 1) Or (dd > 31) Then
InputIsValidated = DayError
Exit Function
End If
text = TextBox1
InputIsValidated = NoErrors
End Function
I currently have a Access Database that an employee manually enters records monthly. Instead I want to upload an excel spreadsheet and populate all columns in the database. The problem is that some of the columns have VBA code that does some calculation, when I upload the spreadsheet, the calculations do not happen, only when you type a value it calculates.
Is there a way around this?
Option Explicit
Option Compare Database
Dim strStopReading As String
Dim datDate As Date
Private Sub AdjWater_BeforeUpdate(Cancel As Integer)
Call UpdateCharges
End Sub
Private Sub Form_AfterUpdate()
varLastReading = StopReading
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
Me.StartReading = varLastReading
If Me.Parent.BillingMethod = 3 Then
If IsNull(Me.Date) Then
AmountCharged = curWater
Else
AmountCharged = GetRate(Me.Date, Me.Parent.strWaterCode)
End If
End If
End Sub
Private Sub Gallons_Change()
Call UpdateCharges
End Sub
Private Sub StartReading_Change()
If Not IsNumeric(StartReading.Text) Then Exit Sub
If Not IsNull(StopReading) Then
Gallons = StopReading - StartReading.Text
UpdateCharges
End If
End Sub
Private Sub StopReading_Change()
If Not IsNumeric(StopReading.Text) Then Exit Sub
If Not IsNull(StartReading) Then
Gallons = StopReading.Text - StartReading
UpdateCharges
End If
End Sub
Public Sub UpdateCharges()
Dim blnChkNum As String
Dim curWaterRate As Currency
Dim curSewerRate As Currency
Dim curMinRate As Currency
'if date is null then use current rate
If IsNull(Me.Date) Then
curWaterRate = curWater
curSewerRate = curSewer
curMinRate = curMinChg
Else
curWaterRate = GetRate(Me.Date, Me.Parent.strWaterCode)
curSewerRate = GetRate(Me.Date, Me.Parent.strSewerCode)
curMinRate = GetRate(Me.Date, Me.Parent.strMinChgCode)
End If
If Me.ActiveControl.Properties("Name") = "txtGallonsToInvoice" Then
'txtGallonsToInvoice is active
blnChkNum = IsNumeric(txtGallonsToInvoice.Text) 'check the text - it may
differ from saved value
If blnChkNum Then
'update amount charged for water
If Me.Parent.BillingMethod = 2 Then AmountCharged =
txtGallonsToInvoice.Text / 1000 * curWaterRate
If Me.Parent.BillingMethod = 3 Then AmountCharged = curWaterRate
'update sewer
If blnSewer = True Then
SewerChg = txtGallonsToInvoice.Text / 1000 * curSewerRate
Else
SewerChg = 0
End If
End If
Else 'Another control has the focus
blnChkNum = IsNumeric(txtGallonsToInvoice) 'check the value - you
can't access the text without the focus
If blnChkNum Then
'update amount charged for water
If Me.Parent.BillingMethod = 2 Then AmountCharged =
txtGallonsToInvoice / 1000 * curWaterRate
If Me.Parent.BillingMethod = 3 Then AmountCharged = curWaterRate
'update sewer
If blnSewer = True Then
SewerChg = txtGallonsToInvoice / 1000 * curSewerRate
Else
SewerChg = 0
End If
End If
End If
If strRateGroup <> "TB" Then 'skip min charge for Houston Ship Repair
If AmountCharged < curMinRate Then
AmountCharged = curMinRate
Me.Min_Water_Chg = True
Else
Me.Min_Water_Chg = False
End If
Else
Me.Min_Water_Chg = False
End If
End Sub
Private Sub txtGallonsToInvoice_Change()
UpdateCharges
End Sub
So the first 9 lines where given to me in a forum I can't remember where. But I built on that and now I would like to use a command button to re-calculate if the use changes a variable listed in this sub.
Private Sub txtWorked_Exit(ByVal Cancel As MSForms.ReturnBoolean)
11 Dim OTRate As Double
OTRate = Me.txtHourlyRate * 1.5
If Me.txtWorked > 40 Then
Me.txtBasePay.Value = Format(Me.txtHourlyRate.Value * 40, "$#,##0.00")
Me.txtOvertime = Format((Me.txtWorked - 40) * OTRate, "$#,##0.00")
Else
Me.txtOvertime.Value = "0"
Me.txtBasePay.Value = Format(Me.txtHourlyRate.Value * Me.txtWorked.Value, "$#,##0.00")
End If
Dim Gross, W2, MASSTax, FICA, Medi, Total, Depends, Feds As Double
Gross = CDbl(txtBonus.Value) + CDbl(txtBasePay.Value) + CDbl(txtOvertime.Value)
W2 = txtClaim * 19
Me.txtGrossPay.Value = Format(Gross, "$#,##0.00")
FICA = Gross * 0.062
Me.txtFICA.Value = Format(FICA, "$#,##0.00")
Medi = Gross * 0.0145
Me.txtMedicare.Value = Format(Medi, "$#,##0.00")
MASSTax = (Gross - (FICA + Medi) - (W2 + 66)) * 0.0545
If chkMassTax = True Then
Me.txtMATax.Value = Format(MASSTax, "$#,##0.00")
Else: Me.txtMATax.Value = "0.00"
End If
If Me.txtClaim.Value = 1 Then
Depends = 76.8
ElseIf Me.txtClaim.Value = 2 Then
Depends = 153.8
ElseIf Me.txtClaim.Value = 3 Then
Depends = 230.7
Else
Depends = 0
End If
If (Gross - Depends) < 765 Then
Feds = ((((Gross - Depends) - 222) * 0.15) + 17.8)
Me.txtFedIncome.Value = Format(Feds, "$#,##.00")
ElseIf (Gross - Depends) > 764 Then
Feds = ((((Gross - Depends) - 764) * 0.25) + 99.1)
Me.txtFedIncome.Value = Format(Feds, "$#,##.00")
Else:
Feds = 0
End If
Total = (txtMATax) + (FICA) + (Medi) + (txtAdditional) + (Feds)
Me.txtTotal.Value = Format(Total, "$#,##0.00")
Me.txtNetPay.Value = Format(Gross - Total, "$#,##0.00")
End Sub
Private Sub cmdReCalculate_Click()
'This where I would lke code to start the sub "txtWorked_Exit" to run again."
End Sub
All you have to do is call the sub routine with the appropriate arguments.
Private Sub cmdReCalculate_Click()
txtWorked_Exit true
End Sub
After trying many solutions that didn't work I tried this.
Private Sub cmdCalculate_Click()
Me.txtWorked.SetFocus
Me.txtAdditional.SetFocus
End Sub
It basically made the Worked textbox active and by doing the same to another text box it effectively preformed an "_Exit" from txtWorked and thus re-ran the txtWorked_Exit Sub.
I have a program that uses a VBA countdown timer.
I can only enter minutes. How can I enter seconds?
In Module1 I enter the time
Public Const AllowedTime As Double = 1
and the code looks like this
Private Sub CommandButton1_Click()
Dim T, E, M As Double, S As Double
T = Timer
Do
E = CDbl(Time) * 24 * 60 * 60 - T
M = AllowedTime - 1 - Int(E / 60)
S = 59 - Round((E / 60 - Int(E / 60)) * 60, 0)
With tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
DoEvents
Loop Until (Timer - T) / 60 >= AllowedTime
End Sub
Private Sub poker_Initialize()
Dim M As Double, S As Double
M = Int(AllowedTime)
S = (AllowedTime - Int(AllowedTime)) * 60
With tBx1
.Value = Format(CStr(M), "00") & ":" & Format(CStr(S), "00")
End With
End Sub
Here is a simple working example
https://app.box.com/s/211uo88dk02x6il8hqj19wyiv1rli2sj
I suggest that you use Date variables for your time calculations because it is much easier.
You will also need a module-level variable if you want the Pause button to work. This code lets you show minutes & seconds. Your AllowedTime variable should be minutes with a decimal part for seconds, or change it to the number of seconds and change the lines that are commented out.
Dim userClickedPause As Boolean ' Gets set to True by the Pause button
Private Sub CommandButton1_Click()
Dim stopTime As Date
userClickedPause = False
' If AllowedTime is the number of minutes with a decimal part:
stopTime = DateAdd("s", Int(AllowedTime * 60), Now) ' add seconds to current time
' If AllowedTime is the number of seconds:
'stopTime = DateAdd("s", AllowedTime, Now) ' add seconds to current time
Do
With tBx1
.Value = Format(stopTime - Now, "Nn:Ss")
End With
DoEvents
If userClickedPause = True Then
Exit Do
End If
Loop Until Now >= stopTime
End Sub
Private Sub CommandButton2_Click()
userClickedPause = True
End Sub