Modifying existing form - how to add date picker

[mml]

Hello
I have a couple of things on the go .

This form to be used request and interpreter .It has been modified and most changes made but I would like to change the text box 3 and and text box 8 as a date picker rather than typing in a date
Is this possible . I haven't been successful as yet

Thank-you as always









Private Sub CommandButton2_Click()
Application.Workbooks.Open ("Q:\ADH_SUPPORT_SVCS\ADH INTERPRETERS ADMIN\Master Interpreter Bookings.xlsm")


Dim wb As Workbook, sh As Worksheet
Set wb = Workbooks("Master Interpreter Bookings.xlsm")
Set sh = wb.Sheets(1)
cAry = Array(Me.ComboBox1, Me.TextBox3, Me.TextBox6, Me.TextBox7, Me.ComboBox2, Me.TextBox5, Me.TextBox8, Me.TextBox9, Me.TextBox10, Me.TextBox11, Me.ComboBox3, Me.TextBox14, Me.TextBox12)
With sh
For i = 1 To 13

.Cells(Rows.Count, i).End(xlUp)(2) = cAry(i - 1).Value
Next
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub








Private Sub UserForm_Initialize()


ComboBox1.AddItem "REQUEST"
ComboBox1.AddItem "CANCEL"

ComboBox2.AddItem "MALE"
ComboBox2.AddItem "FEMALE"

ComboBox3.AddItem "GPU"
'ComboBox3.AddItem "SRU"
' ComboBox3.AddItem "SNU"
'ComboBox3.AddItem "OMS"
'ComboBox3.AddItem "ORTHO"
End Sub




Private Sub CommandButton1_Click()
Dim irow As Long
Dim wb As Workbook
Dim ws As Worksheet


Set ws = Worksheets("Interpreter Requests")


'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow).Value = Me.ComboBox1.Text
.Range("B" & irow).Value = Me.TextBox3.Text
.Range("C" & irow).Value = Me.TextBox6.Text
.Range("D" & irow).Value = Me.TextBox7.Text
.Range("E" & irow).Value = Me.ComboBox2.Text
.Range("F" & irow).Value = Me.TextBox5.Text
.Range("G" & irow).Value = Me.TextBox8.Text
.Range("H" & irow).Value = Me.TextBox9.Text
.Range("I" & irow).Value = Me.TextBox10.Text
.Range("J" & irow).Value = Me.TextBox11.Text
.Range("K" & irow).Value = Me.ComboBox3.Text
.Range("L" & irow).Value = Me.TextBox14.Text
.Range("M" & irow).Value = Me.TextBox12.Text
.Range("N" & irow).Value = Me.TextBox13.Text

End With
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
ComboBox1.Value = ""
TextBox3.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
ComboBox2.Value = ""
TextBox5.Value = ""
TextBox8.Value = ""
TextBox9.Value = ""
TextBox10.Value = ""
TextBox11.Value = ""
ComboBox3.Value = ""
TextBox14.Value = ""
TextBox12.Value = ""
TextBox13.Value = ""




End Sub

[NoSparks]

You could include a form based date picker such as the one from Trevor Eyre. (https://trevoreyre.com/portfolio/excel-datepicker/)
Then something like

Private Sub TextBox3_Enter()
Dim datevalue As Date
datevalue = CalendarForm.GetDate
If datevalue = "12:00:00 AM" Then
TextBox3.value = ""
Else
TextBox3.value = datevalue
End If
End Sub

[mml]

Hello
I have looked at the site above ...not disregarding its just beyond my present skill level. So I went searching for DTPicker1 and I sort if have it working however I am am having issues when adding a new request via the form. First submission all OK the second is a problem
The date submitted I would like to have a default as "Todays"date and the the duration at 60. Each Time I add a new request they are absent . I hope someone can assist with some refinement. All fields seem to be transferring into the Interpreter request worksheet 26091
If this could be done it would save a couple of hundred trees per year with paper copies and provide some automation. Any assistance would be greatly appreciated

[NoSparks]

I can't run your user form, get the message 'Could not load an object because it is not available on this machine'
this is because of the reference to Microsoft Windows Common Controls-2 6.0 (SP6), which use to be part of MS Office.
I believe it was removed when 64 bit Office became an option. Hense the reason for suggestion of the form based date picker which would be part of the file and run for everyone.


I am am having issues when adding a new request via the form. First submission all OK the second is a problem
The date submitted I would like to have a default as "Todays"date and the the duration at 60. Each Time I add a new request they are absent.
In your SAVE button code things are being setup for the next request by blanking everything after the save. Change these to what you're wanting.

[mml]

Hi NoSparks
yes I did have to install the module to get the date picker . To be really clear does this mean that module would have to be installed on every PC that runs this form?
If this is the case can you assist in the code for the calendar ?
In the meantime I did follow your suggestion and looked at the SAVE command and made changes ( thanks for pointing me to the obvious !) ....and it worked ,but if this a local PC only issue then i have to find another route

I have included the code hope you can find some time to help , it would be really appreciated


Private Sub CommandButton2_Click()
Application.Workbooks.Open ("Q:\ADH_SUPPORT_SVCS\xxxxxxxxxx\Master Interpreter Bookings.xlsm")


Dim wb As Workbook, sh As Worksheet
Set wb = Workbooks("Master Interpreter Bookings.xlsm")
Set sh = wb.Sheets(1)
cAry = Array(Me.ComboBox1, Me.TextBox3, Me.TextBox6, Me.TextBox7, Me.ComboBox2, Me.TextBox5, Me.TextBox9, Me.TextBox16, Me.TextBox11, Me.TextBox15, Me.TextBox14)
With sh
For i = 1 To 13

.Cells(Rows.Count, i).End(xlUp)(2) = cAry(i - 1).Value
Next
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close


End Sub




'Enter number for UR , format set as number


Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 46 Or KeyAscii = 32 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
MsgBox "Invalid key pressed,enter Number"
End If




End Sub


Private Sub UserForm_Initialize()


ComboBox1.AddItem "REQUEST"
ComboBox1.AddItem "CANCEL"

ComboBox2.AddItem "MALE"
ComboBox2.AddItem "FEMALE"

'ComboBox3.AddItem "GPU"
'ComboBox3.AddItem "SRU"
'ComboBox3.AddItem "SNU"
'ComboBox3.AddItem "OMS"
'ComboBox3.AddItem "ORTHO"

ComboBox4.AddItem "MML"
ComboBox4.AddItem "IB"
ComboBox4.AddItem "KS"
ComboBox4.AddItem "Other"

ComboBox5.AddItem "Miss"
ComboBox5.AddItem "Mr"
ComboBox5.AddItem "Mrs"
ComboBox5.AddItem "Ms"
Me.TextBox3.Text = Format(Now(), "DD/MM/YYYY")

End Sub




Private Sub CommandButton1_Click()
Dim irow As Long
Dim wb As Workbook
Dim ws As Worksheet


Set ws = Worksheets("Interpreter Requests")


'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow).Value = Me.ComboBox1.Text
.Range("B" & irow).Value = Me.TextBox3.Text
.Range("C" & irow).Value = Me.TextBox6.Text
.Range("D" & irow).Value = Me.TextBox7.Text
.Range("E" & irow).Value = Me.ComboBox2.Text
.Range("F" & irow).Value = Me.TextBox5.Text
'.Range("G" & irow).Value = Me.TextBox8.Text
.Range("G" & irow).Value = Me.DTPicker1.Value
.Range("H" & irow).Value = Me.TextBox9.Text
.Range("I" & irow).Value = Me.TextBox16.Text
.Range("J" & irow).Value = Me.TextBox11.Text
.Range("K" & irow).Value = Me.TextBox15.Text
.Range("L" & irow).Value = Me.TextBox14.Text
.Range("M" & irow).Value = Me.ComboBox4.Text
.Range("N" & irow).Value = Me.TextBox13.Text

End With
'TextBox1.Value = ""
'TextBox2.Value = ""
'TextBox3.Value = ""
ComboBox1.Value = ""
'TextBox3.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
ComboBox2.Value = ""
TextBox5.Value = ""
'TextBox8.Value = ""
TextBox9.Value = ""
'TextBox16.Value = ""
TextBox11.Value = ""
ComboBox4.Value = ""
ComboBox5.Value = ""
TextBox14.Value = ""
'TextBox12.Value = ""
TextBox13.Value = ""
End Sub

[Paul_Hossler]

yes I did have to install the module to get the date picker . To be really clear does this mean that module would have to be installed on every PC that runs this form?

Once the code has been incorporated into your original WB, it should go with the WB to who ever to give it to

[NoSparks]

does this mean that module would have to be installed on every PC that runs this form? Yes

can you assist in the code for the calendar ? There isn't actually any code needed (from you) for the calendar.
If you open both your file and the Trevor Eyre file you can just drag the calendar form from his file to your file.

The programming you require is for triggering the calendar.
For your textbox3 where you're putting in a default date I'd use the double click event for that textbox to bring up the calendar in case the date needs to be changed.
For your textbox8, which you have in the picture but not on your userform, you can use the textbox on enter event to bring up the calendar.
Also be sure to remove the reference to Microsoft Windows Common Controls-2 6.0 (SP6)

Hope this helps.

[snb]

Simply so:

[mml]

Hello all and especially NoSparks
I will get this into work tomorrow as a trial . As is usual my Govt department only does things on the cheap and as a knee jerk reaction.
Thank you for taking the time to help me out, really appreciated.
I would like you to know that this will reduce the amount of hard copy forms to zero in my department , until now these numbered in the 1000's yearly and save a huge amount of time . Its my hope that it will go further and be adopted by other admin staff in other areas.
Its a small automation BUT the impacts will be apparent everywhere ...especially trees.
Cheers and thanks :thumb

[mml]

Hi The file is in and working however I have one more request
This workbook will be used by more than one user , I would like to have one file only and staff only access that file which is stored on a network drive . When its in use I haven't been able to find the code to provide a message stating that the "userform "open is in use try again later ".
Hadn't thought of this scenario previously

can anyone help ? Found this code But it throws up an error each time " compile error outside procedure"
Open to all suggestions




Dim location As StringDim wbk As Workbook
location = "Q:\SADS_ADH\ADH GPU\GPU Reception Access\Temporary PF\INTERPRETER\PFInterpreter Request Form PF GPU_Final.xls"
Set wbk = Workbooks.Open(location)
'Check to see if file is already openIf wbk.ReadOnly Then ActiveWorkbook.Close MsgBox "Cannot update the excelsheet, someone currently using file. Please try again later." Exit SubEnd If

[NoSparks]

Sorry, I can't help with that.
Ten responses into this thread there will be few who will see this question.
It's not related to the title, so you would be best to post it as a new question.

[mml]

Ok all good