I am taking two input from USERFORM "CheckIn Time (hh:mm format)" and "Checkout Time (hh:mm format)" through TextBox, and trying to get immediate output in 3rd Text Box (hh:mm format) which shows difference between check in and checkout.
To achieve this I am using Call Sub procedure method.
However I am getting error
"Run time 13: Type mismatch".
I am new to VBA and I am literally stuck at this since 2 weeks. Please help.
I tried changing DATA type but didn't get any positive result.
Private Sub CHKIN_Change() 'Calling GetTime
Call GetTime
End Sub
Private Sub CHKOUT_Change() 'Calling GetTime
Call GetTime
End Sub
Private Sub TOTALHRS_Change() 'Calling GetTime
Call GetTime
End Sub
'below Calculating difference b/t Checkin & Checkout, displaying in "TOTALHRS" textbox
Sub GetTime()
Dim Time1, Time2, TotalTime As Date
Time1 = CHKIN.Text
Time2 = CHKOUT.Text
TotalTime = DateDiff("s", Time1, Time2)
TotalTime = Totalhour / 86400
TOTALHRS.Text = Format(Totalhour, "hh:mm")
End Sub
'Using below code to convert checkin and checkout input in hh:mm format.
Private Sub CHKIN_AfterUpdate()
Dim tDate As Date
Dim tString As String
With CHKIN
'Check if user put in a colon or not
If InStr(1, .Value, ":", vbTextCompare) = 0 Then
'If not, make string 4 digits and insert colon
tString = Format(.Value, "0000")
tDate = TimeSerial(Left(tString, 2), Right(tString, 2), 0)
CHKIN.Value = Format(tDate, "HH:MM")
Else
'Otherwise, take value as given
.Value = Format(.Value, "hh:mm")
End If
End With
Exit Sub
End Sub
Desired result wanted: checkout - checkin = hh:mm
Example: 23:20 - 9:35 = 13:45
I'm setting up a userform for employees to fill in data. They need to fill in the date like DD-MM-YYYY the output must also be DD-MM-YYYY. However the code I use changes input 5-12-2019 (DD-MM-YYYY), to output 12-5-2019 (MM-DD-YYYY). In the userform it stays like (DD-MM-YYYY) expect for when you tranfer it to your excel sheet. If the month is above 13 it doesn't change, so input 13-12-2019 (DD-MM-YYYY) stays output 13-12-2019 (DD-MM-YYYY). How is it possible that the code changes the output but not everytime the same way, did I do something wrong in the code?
Private Sub TextBox1_BeforeUpdate(ByVal cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox1.Text) Then
Me.TextBox1.Text = Format(Me.TextBox1.Text, "DD-MM-YYYY")
Else
MsgBox "Vul een geldige datum in", vbRetryCancel + vbCritical
End If
End Sub
Public Function IsTime(Expression As Variant) As Boolean
If IsDate(Expression) Then
IsTime = (Int(CSng(CDate(Expression))) = 0)
End If
End Function
Read the date as a string. E.g. 5-12-2009.
Split the string by -.
The 0th value is the day, the 1st is the month, the 2nd is the year.
From there, you have a fully functioning date, using DateSerial().
Public Function StringToDate(myInput As String) As Date
Dim day As Long
Dim month As Long
Dim year As Long
Dim dateArray As Variant
dateArray = Split(myInput, "-")
day = dateArray(0)
month = dateArray(1)
year = dateArray(2)
StringToDate = DateSerial(year, month, day)
End Function
Public Sub Main()
Debug.Print month(StringToDate("05-10-2001"))
Debug.Print StringToDate("05-10-2001")
End Sub
I have a small user interface, using Excel's Form functionality, which allows users to input start and finish dates for projects.
If the user puts in dates that are available in both the US and UK formats (e.g. 7th May 2018, 5/7/2018) the variable will come out in the US format (e.g. 5th July 2018, 5/7/2018). However, if the dates are not available in both formats (e.g. 31st August 2018, 31/8/2018), the variable will return in the (correct) UK format.
My current code for the particular variables in the form is as follows:
Private Sub Calculate_Click()
sDate = CDate(sDate.Text)
eDate = CDate(eDate.Text)
If sDate = vbNullString Then
sDate = Now()
End If
If eDate = vbNullString Then
eDate = Now() + 40
End If
If HoursPD = vbNullString Then
HoursPD = 6
ElseIf HoursPD > 7.5 Then
HoursPD = 7.5
End If
Me.Hide
End Sub
Is there any way to ensure that the variable format is fixed to the UK version?
I'd use a separate procedure to check any dates on the form.
This also colours the control red if a non-valid date is entered.
Formatting the date as dd-mmm-yyyy makes it easier to spot a date in the wrong format as month is written in full(ish).
Public Sub FormatDate(ctrl As Control)
Dim dDate As Date
Dim IsDate As Boolean
On Error GoTo ERR_HANDLE
If Replace(ctrl.Value, " ", "") <> "" Then
On Error Resume Next
dDate = CDate(ctrl.Value)
IsDate = (Err.Number = 0)
On Error GoTo 0
On Error GoTo ERR_HANDLE
If IsDate Then
ctrl.Value = Format(ctrl.Value, "dd-mmm-yyyy")
ctrl.BackColor = RGB(255, 255, 255)
Else
ctrl.BackColor = RGB(255, 0, 0)
End If
End If
EXIT_PROC:
On Error GoTo 0
Exit Sub
ERR_HANDLE:
'Error Handling routines.
'DisplayError Err.Number, Err.Description, "mdl_FormatDate.FormatDate()"
Resume EXIT_PROC
End Sub
This is then called on the AfterUpdate event of the control:
Private Sub txtDate_AfterUpdate()
On Error GoTo ERR_HANDLE
With Me
FormatDate .txtDate
End With
EXIT_PROC:
On Error GoTo 0
Exit Sub
ERR_HANDLE:
'Error Handling routines.
'DisplayError Err.Number, Err.Description, "Data_Entry_Form.txtDate_AfterUpdate()"
Resume EXIT_PROC
End Sub
You could do something like below, but your users should know to enter the dates in the correct (UK) format:
sDate = Format(CDate(sDate.Text), "dd/mm/yyyy")
EDate = Format(CDate(EDate.Text), "dd/mm/yyyy")
I'm looking for a way to automatically format the date in a VBA text box to a MM/DD/YYYY format, and I want it to format as the user is typing it in. For instance, once the user types in the second number, the program will automatically type in a "/". Now, I got this working (as well as the second dash) with the following code:
Private Sub txtBoxBDayHim_Change()
If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
End Sub
Now, this works great when typing. However, when trying to delete, it still enters in the dashes, so its impossible for the user to delete past one of the dashes (deleting a dash results in a length of 2 or 5, and the sub is then run again, adding in another dash). Any suggestions on a better way to do this?
I never suggest using Textboxes or Inputboxes to accept dates. So many things can go wrong. I cannot even suggest using the Calendar Control or the Date Picker as for that you need to register the mscal.ocx or mscomct2.ocx and that is very painful as they are not freely distributable files.
Here is what I recommend. You can use this custom made calendar to accept dates from the user
PROS:
You don't have to worry about user inputting wrong info
You don't have to worry user pasting in the textbox
You don't have to worry about writing any major code
Attractive GUI
Can be easily incorporated in your application
Doesn't use any controls for which you need to reference any libraries like mscal.ocx or mscomct2.ocx
CONS:
Ummm...Ummm... Can't think of any...
HOW TO USE IT (File missing from my dropbox. Please refer to the bottom of the post for an upgraded version of the calendar)
Download the Userform1.frm and Userform1.frx from here.
In your VBA, simply import Userform1.frm as shown in the image below.
Importing the form
RUNNING IT
You can call it in any procedure. For example
Sub Sample()
UserForm1.Show
End Sub
SCREEN SHOTS IN ACTION
NOTE: You may also want to see Taking Calendar to new level
This is the same concept as Siddharth Rout's answer. But I wanted a date picker which could be fully customized so that the look and feel could be tailored to whatever project it's being used in.
You can click this link to download the custom date picker I came up with. Below are some screenshots of the form in action.
To use the date picker, simply import the CalendarForm.frm file into your VBA project. Each of the calendars above can be obtained with one single function call. The result just depends on the arguments you use (all of which are optional), so you can customize it as much or as little as you want.
For example, the most basic calendar on the left can be obtained by the following line of code:
MyDateVariable = CalendarForm.GetDate
That's all there is to it. From there, you just include whichever arguments you want to get the calendar you want. The function call below will generate the green calendar on the right:
MyDateVariable = CalendarForm.GetDate( _
SelectedDate:=Date, _
DateFontSize:=11, _
TodayButton:=True, _
BackgroundColor:=RGB(242, 248, 238), _
HeaderColor:=RGB(84, 130, 53), _
HeaderFontColor:=RGB(255, 255, 255), _
SubHeaderColor:=RGB(226, 239, 218), _
SubHeaderFontColor:=RGB(55, 86, 35), _
DateColor:=RGB(242, 248, 238), _
DateFontColor:=RGB(55, 86, 35), _
SaturdayFontColor:=RGB(55, 86, 35), _
SundayFontColor:=RGB(55, 86, 35), _
TrailingMonthFontColor:=RGB(106, 163, 67), _
DateHoverColor:=RGB(198, 224, 180), _
DateSelectedColor:=RGB(169, 208, 142), _
TodayFontColor:=RGB(255, 0, 0), _
DateSpecialEffect:=fmSpecialEffectRaised)
Here is a small taste of some of the features it includes. All options are fully documented in the userform module itself:
Ease of use. The userform is completely self-contained, and can be imported into any VBA project and used without much, if any additional coding.
Simple, attractive design.
Fully customizable functionality, size, and color scheme
Limit user selection to a specific date range
Choose any day for the first day of the week
Include week numbers, and support for ISO standard
Clicking the month or year label in the header reveals selectable comboboxes
Dates change color when you mouse over them
Add something to track the length and allow you to do "checks" on whether the user is adding or subtracting text. This is currently untested but something similar to this should work (especially if you have a userform).
'add this to your userform or make it a static variable if it is not part of a userform
private oldLength as integer
Private Sub txtBoxBDayHim_Change()
if ( oldlength > txboxbdayhim.textlength ) then
oldlength =txtBoxBDayHim.textlength
exit sub
end if
If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
end if
oldlength =txtBoxBDayHim.textlength
End Sub
I too, one way or another stumbled on the same dilemma, why the heck Excel VBA doesn't have a Date Picker. Thanks to Sid, who made an awesome job to create something for all of us.
Nonetheless, I came to a point where I need to create my own. And I am posting it here since a lot of people I'm sure lands on this post and benefit from it.
What I did was very simple as what Sid does except that I do not use a temporary worksheet. I thought the calculations are very simple and straight forward so there's no need to dump it somewhere else. Here's the final output of the calendar:
How to set it up:
Create 42 Label controls and name it sequentially and arranged left to right, top to bottom (This labels contains greyed 25 up to greyed 5 above). Change the name of the Label controls to Label_01,Label_02 and so on. Set all 42 labels Tag property to dts.
Create 7 more Label controls for the header (this will contain Su,Mo,Tu...)
Create 2 more Label control, one for the horizontal line (height set to 1) and one for the Month and Year display. Name the Label used for displaying month and year Label_MthYr
Insert 2 Image controls, one to contain the left icon to scroll previous months and one to scroll next month (I prefer simple left and right arrow head icon). Name it Image_Left and Image_Right
The layout should be more or less like this (I leave the creativity to anyone who'll use this).
Declaration: We need one variable declared at the very top to hold the current month selected.
Option Explicit
Private curMonth As Date
Private Procedure and Functions:
Private Function FirstCalSun(ref_date As Date) As Date
'/* returns the first Calendar sunday */
FirstCalSun = DateSerial(Year(ref_date), _
Month(ref_date), 1) - (Weekday(ref_date) - 1)
End Function
Private Sub Build_Calendar(first_sunday As Date)
'/* This builds the calendar and adds formatting to it */
Dim lDate As MSForms.Label
Dim i As Integer, a_date As Date
For i = 1 To 42
a_date = first_sunday + (i - 1)
Set lDate = Me.Controls("Label_" & Format(i, "00"))
lDate.Caption = Day(a_date)
If Month(a_date) <> Month(curMonth) Then
lDate.ForeColor = &H80000011
Else
If Weekday(a_date) = 1 Then
lDate.ForeColor = &HC0&
Else
lDate.ForeColor = &H80000012
End If
End If
Next
End Sub
Private Sub select_label(msForm_C As MSForms.Control)
'/* Capture the selected date */
Dim i As Integer, sel_date As Date
i = Split(msForm_C.Name, "_")(1) - 1
sel_date = FirstCalSun(curMonth) + i
'/* Transfer the date where you want it to go */
MsgBox sel_date
End Sub
Image Events:
Private Sub Image_Left_Click()
If Month(curMonth) = 1 Then
curMonth = DateSerial(Year(curMonth) - 1, 12, 1)
Else
curMonth = DateSerial(Year(curMonth), Month(curMonth) - 1, 1)
End If
With Me
.Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
Build_Calendar FirstCalSun(curMonth)
End With
End Sub
Private Sub Image_Right_Click()
If Month(curMonth) = 12 Then
curMonth = DateSerial(Year(curMonth) + 1, 1, 1)
Else
curMonth = DateSerial(Year(curMonth), Month(curMonth) + 1, 1)
End If
With Me
.Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
Build_Calendar FirstCalSun(curMonth)
End With
End Sub
I added this to make it look like the user is clicking the label and should be done on the Image_Right control too.
Private Sub Image_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Me.Image_Left.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Image_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Me.Image_Left.BorderStyle = fmBorderStyleNone
End Sub
Label Events: All of this should be done for all 42 labels (Label_01 to Lable_42) Tip: Build the first 10 and just use find and replace for the remaining.
Private Sub Label_01_Click()
select_label Me.Label_01
End Sub
This is for hovering over dates and clicking effect.
Private Sub Label_01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Me.Label_01.BorderStyle = fmBorderStyleSingle
End Sub
Private Sub Label_01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Me.Label_01.BackColor = &H8000000B
End Sub
Private Sub Label_01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
Me.Label_01.BorderStyle = fmBorderStyleNone
End Sub
UserForm Events:
Private Sub UserForm_Initialize()
'/* This is to initialize everything */
With Me
curMonth = DateSerial(Year(Date), Month(Date), 1)
.Label_MthYr = Format(curMonth, "mmmm, yyyy")
Build_Calendar FirstCalSun(curMonth)
End With
End Sub
Again, just for the hovering over dates effect.
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
With Me
Dim ctl As MSForms.Control, lb As MSForms.Label
For Each ctl In .Controls
If ctl.Tag = "dts" Then
Set lb = ctl: lb.BackColor = &H80000005
End If
Next
End With
End Sub
And that's it. This is raw and you can add your own twist to it.
I've been using this for awhile and I have no issues (performance and functionality wise). No Error Handling yet but can be easily managed I guess. Actually, without the effects, the code is too short. You can manage where your dates go in the select_label procedure. HTH.
Just for fun I took Siddharth's suggestion of separate textboxes and did comboboxes. If anybody's interested, add a userform with three comboboxes named cboDay, cboMonth and cboYear and arrange them left to right. Then paste the code below into the UserForm's code module. The required combobox properties are set in UserFormInitialization, so no additional prep should be required.
The tricky part is changing the day when it becomes invalid because of a change in year or month. This code just resets it to 01 when that happens and highlights cboDay.
I haven't coded anything like this in a while. Hopefully it will be of interest to somebody, someday. If not it was fun!
Dim Initializing As Boolean
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox
Initializing = True
With Me
With .cboMonth
' .AddItem "month"
For i = 1 To 12
.AddItem Format(i, "00")
Next i
.Tag = "DateControl"
End With
With .cboDay
' .AddItem "day"
For i = 1 To 31
.AddItem Format(i, "00")
Next i
.Tag = "DateControl"
End With
With .cboYear
' .AddItem "year"
For i = Year(Now()) To Year(Now()) + 12
.AddItem i
Next i
.Tag = "DateControl"
End With
DoEvents
For Each ctl In Me.Controls
If ctl.Tag = "DateControl" Then
Set cbo = ctl
With cbo
.ListIndex = 0
.MatchRequired = True
.MatchEntry = fmMatchEntryComplete
.Style = fmStyleDropDownList
End With
End If
Next ctl
End With
Initializing = False
End Sub
Private Sub cboDay_Change()
If Not Initializing Then
If Not IsValidDate Then
ResetMonth
End If
End If
End Sub
Private Sub cboMonth_Change()
If Not Initializing Then
ResetDayList
If Not IsValidDate Then
ResetMonth
End If
End If
End Sub
Private Sub cboYear_Change()
If Not Initializing Then
ResetDayList
If Not IsValidDate Then
ResetMonth
End If
End If
End Sub
Function IsValidDate() As Boolean
With Me
IsValidDate = IsDate(.cboMonth & "/" & .cboDay & "/" & .cboYear)
End With
End Function
Sub ResetDayList()
Dim i As Long
Dim StartDay As String
With Me.cboDay
StartDay = .Text
For i = 31 To 29 Step -1
On Error Resume Next
.RemoveItem i - 1
On Error GoTo 0
Next i
For i = 29 To 31
If IsDate(Me.cboMonth & "/" & i & "/" & Me.cboYear) Then
.AddItem Format(i, "0")
End If
Next i
On Error Resume Next
.Text = StartDay
If Err.Number <> 0 Then
.SetFocus
.ListIndex = 0
End If
End With
End Sub
Sub ResetMonth()
Me.cboDay.ListIndex = 0
End Sub
For a quick solution, I usually do like this.
This approach will allow the user to enter date in any format they like in the textbox, and finally format in mm/dd/yyyy format when he is done editing. So it is quite flexible:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox1.Text <> "" Then
If IsDate(TextBox1.Text) Then
TextBox1.Text = Format(TextBox1.Text, "mm/dd/yyyy")
Else
MsgBox "Please enter a valid date!"
Cancel = True
End If
End If
End Sub
However, I think what Sid developed is a much better approach - a full fledged date picker control.
You could use an input mask on the text box, too. If you set the mask to ##/##/#### it will always be formatted as you type and you don't need to do any coding other than checking to see if what was entered was a true date.
Which just a few easy lines
txtUserName.SetFocus
If IsDate(txtUserName.text) Then
Debug.Print Format(CDate(txtUserName.text), "MM/DD/YYYY")
Else
Debug.Print "Not a real date"
End If
While I agree with what's mentioned in the answers below, suggesting that this is a very bad design for a Userform unless copious amounts of error checks are included...
to accomplish what you need to do, with minimal changes to your code, there are two approaches.
Use KeyUp() event instead of Change event for the textbox. Here is an example:
Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim TextStr As String
TextStr = TextBox2.Text
If KeyCode <> 8 Then ' i.e. not a backspace
If (Len(TextStr) = 2 Or Len(TextStr) = 5) Then
TextStr = TextStr & "/"
End If
End If
TextBox2.Text = TextStr
End Sub
Alternately, if you need to use the Change() event, use the following code. This alters the behavior so the user keeps entering the numbers, as
12072003
while the result as he's typing appears as
12/07/2003
But the '/' character appears only once the first character of the DD i.e. 0 of 07 is entered. Not ideal, but will still handle backspaces.
Private Sub TextBox1_Change()
Dim TextStr As String
TextStr = TextBox1.Text
If (Len(TextStr) = 3 And Mid(TextStr, 3, 1) <> "/") Then
TextStr = Left(TextStr, 2) & "/" & Right(TextStr, 1)
ElseIf (Len(TextStr) = 6 And Mid(TextStr, 6, 1) <> "/") Then
TextStr = Left(TextStr, 5) & "/" & Right(TextStr, 1)
End If
TextBox1.Text = TextStr
End Sub
Private Sub txtBoxBDayHim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then 'only numbers and backspace
If KeyAscii = 8 Then 'if backspace, ignores + "/"
Else
If txtBoxBDayHim.TextLength = 10 Then 'limit textbox to 10 characters
KeyAscii = 0
Else
If txtBoxBDayHim.TextLength = 2 Or txtBoxBDayHim.TextLength = 5 Then 'adds / automatically
txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
End If
End If
End If
Else
KeyAscii = 0
End If
End Sub
This works for me. :)
Your code helped me a lot. Thanks!
I'm brazilian and my english is poor, sorry for any mistake.