Using Date picker in Visual Basic with a Userform

PMRetired2012 · Feb 6th 2021

[xpost][/xpost]

What im wanting to do is this (There are 6 Datepickers in the workbook)

1. I want to be able to when i open a userform in excel i want to have the Date picker to default to the current date.

2. I want know in the code that im about to post what code i should use to make this happen and where to put it in the macro. This code is in the initialize part of the workbook.

3. Im going to attach the excel file also.

4.The Date picker i have used is the one that is in the tool box in the visual basic.

5. If you cant tell me how to do this with the toolbox please let me know how it can be done with my code that i have by adding more code or how ever.

Thanks

Code

Private Sub UserForm_Initialize()
'Combobox1
With ComboBox1
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'ComboBox2
With ComboBox2
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'ComboBox3


With Sheets("OPTIONS PAGE")
Me.ComboBox3.List = .Range("C2", .Cells(.Rows.Count, "C").End(xlUp)).Value
End With


'ComboBox4
With ComboBox4
.AddItem "UTILITY"
.AddItem "RESALE"
.AddItem "INSURANCE"
.AddItem "SUPPLIES"
.AddItem "TAXES"
.AddItem "CO2"
.AddItem "LICENSE"
.AddItem "EQUIPMENT"
.AddItem "MAINTENACE"
.AddItem "MEMBERSHIP"
.AddItem "LABOR"
.AddItem "REPAIRS"
.AddItem "MERCHANT LIC"
End With






'Combobox5
With ComboBox5
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'Combobox 6
With ComboBox6
.AddItem "Sandy"
.AddItem "Kim"
End With


'Combobox 7
With ComboBox7
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'Combobox 8
With ComboBox8
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'Combobox 9
With ComboBox9
.AddItem "JANUARY"
.AddItem "FEBUARY"
.AddItem "MARCH"
.AddItem "APRIL"
.AddItem "MAY"
.AddItem "JUNE"
.AddItem "JULY"
.AddItem "AUGUST"
.AddItem "SEPTEMBER"
.AddItem "OCTOBER"
.AddItem "NOVEMBER"
.AddItem "DECEMBER"
End With


'Combobox 10
With ComboBox10
.AddItem "21.00"
.AddItem "35.00"
.AddItem "38.50"
.AddItem "42.00"
.AddItem "77.00"
End With


'Combobox 11
With Sheets("OPTIONS PAGE")
Me.ComboBox11.List = .Range("G2", .Cells(.Rows.Count, "G").End(xlUp)).Value
End With




End Sub

Display More

Code

'Reciepts


Private Sub CommandButton1_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheet = ComboBox1.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"


Exit Sub
End If


Sheets(Sheet).Select
Set findBlank = Range("H2:H53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker1.Value
ActiveCell.Offset(0, 1).Value = TextBox1.Text
ActiveCell.Offset(0, 2).Value = TextBox2.Text
ActiveCell.Offset(0, 3).Value = TextBox3.Text


'Sort Reciepts
Sheets(Sheet).Range("H2:L53").Sort key1:=Range("H2"), order1:=xlAscending, Header:=xlYes








'Clear Form
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""


End Sub

Display More

Code

'Expences


Private Sub CommandButton2_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheet = ComboBox2.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"
Exit Sub
End If


Sheets(Sheet).Select
Set findBlank = Range("A2:A53").Find(What:="", lookat:=xlWhole)
findBlank.Select


If ComboBox3 <> "" Then
ActiveCell.Value = DTPicker2.Value
ActiveCell.Offset(0, 1).Value = TextBox4.Text
ActiveCell.Offset(0, 2).Value = ComboBox3.Text
ActiveCell.Offset(0, 3).Value = ComboBox4.Text
ActiveCell.Offset(0, 4).Value = TextBox5.Text
ActiveCell.Offset(0, 5).Value = TextBox6.Text
End If


'CC fees
If TextBox7.Text <> "" Then
Set findBlank = Range("S2:S53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker2.Value
ActiveCell.Offset(0, 1).Value = TextBox7.Text


'Sort CC fees
Sheets(Sheet).Range("S2:T53").Sort key1:=Range("S2"), order1:=xlAscending, Header:=xlYes
End If










'Add UTILITY
If ComboBox4 = "UTILITY" Then
Set findBlank = Range("Z2:Z23").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker2.Value
ActiveCell.Offset(0, 1).Value = TextBox5.Text


'Sort Utility
Sheets(Sheet).Range("Z2:AA23").Sort key1:=Range("Z2"), order1:=xlAscending, Header:=xlYes
End If




'Add INSURANCE
If ComboBox4 = "INSURANCE" Then
Set findBlank = Range("Z28:Z53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker2.Value
ActiveCell.Offset(0, 1).Value = TextBox5.Text


'Sort Insurance
Sheets(Sheet).Range("Z28:AA53").Sort key1:=Range("Z28"), order1:=xlAscending, Header:=xlYes
End If




'Add TAXES PAID
If ComboBox4 = "TAXES" Then
Set findBlank = Range("AK42:AK53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker2.Value
ActiveCell.Offset(0, 1).Value = TextBox5.Text


'Sort Taxes
Sheets(Sheet).Range("AK42:AL53").Sort key1:=Range("AK28"), order1:=xlAscending, Header:=xlYes
End If




'Sort Expences
Sheets(Sheet).Range("A2:F53").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes




'Clear Form
TextBox4.Text = ""
ComboBox3.Text = ""
ComboBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""


End Sub

Display More

Code

'Labor Costs
Private Sub CommandButton3_Click()
Dim lr As Long
Dim findDate As Date
Application.ScreenUpdating = True
Sheet = ComboBox5.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"
Exit Sub
End If
Sheets(Sheet).Select
iDate = Trim(DTPicker3.Value)


'set findDate = Range("V3:V53").Find(What:=iDate, LookAt:=xlWhole)
Range("V3").Select
For i = 1 To 51
If Trim(ActiveCell.Value) = iDate Then
myName = ComboBox6.Text
If myName = "Sandy" Then myCol = "W"
If myName = "Kim" Then myCol = "X"
Range(myCol & ActiveCell.Row).Value = ComboBox10.Value
'Sort Labor Costs
Sheets(Sheet).Range("V2:X53").Sort key1:=Range("V2"), order1:=xlAscending, Header:=xlYes
'Clear Form
ComboBox6.Text = ""
ComboBox10.Text = ""
Exit Sub
Else
'i = i + 1
Range("V" & i + 2).Select
End If
Next
lr = Range("V53").End(xlUp).Row + 1
myName = ComboBox6.Text
If myName = "Sandy" Then myCol = "W"
If myName = "Kim" Then myCol = "X"
Range("V" & lr).Value = iDate


Range(myCol & lr).Value = ComboBox10.Value






'Sort Labor Costs
Sheets(Sheet).Range("V2:X53").Sort key1:=Range("V2"), order1:=xlAscending, Header:=xlYes






'Clear Form
ComboBox6.Text = ""
ComboBox10.Text = ""


End Sub

Display More

Code

'Bank Deposits


Private Sub CommandButton4_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheet = ComboBox7.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"
Exit Sub
End If
Sheets(Sheet).Select
Set findBlank = Range("AK2:AK53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker4.Value
ActiveCell.Offset(0, 1).Value = TextBox9.Text


'Sort Bank Deposits
Sheets(Sheet).Range("AK2:AL53").Sort key1:=Range("AK2"), order1:=xlAscending, Header:=xlYes




'Clear Form
ComboBox7.Text = ""
TextBox9.Text = ""


End Sub

Display More

Code

'Product Loss


Private Sub CommandButton5_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheet = ComboBox8.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"
Exit Sub
End If
Sheets(Sheet).Select
Set findBlank = Range("AC2:AC53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker5.Value
ActiveCell.Offset(0, 1).Value = TextBox10.Text
ActiveCell.Offset(0, 2).Value = ComboBox11.Text


'Sort Product Loss


Sheets(Sheet).Range("AC2:AE53").Sort key1:=Range("AC2"), order1:=xlAscending, Header:=xlYes


'Clear Form
TextBox10.Text = ""
ComboBox11.Text = ""
End Sub

Display More

Code

'Wendy Sales


Private Sub CommandButton6_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheet = ComboBox9.Text
If Sheet = "" Then
MsgBox "Select Month", vbInformation, "Error"
Exit Sub
End If
Sheets(Sheet).Select
Set findBlank = Range("AH2:AH53").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker6.Value
ActiveCell.Offset(0, 1).Value = TextBox12.Text


'Sort Wendy Sales
Sheets(Sheet).Range("AH2:AI53").Sort key1:=Range("AH2"), order1:=xlAscending, Header:=xlYes


'Clear Form
TextBox12.Text = ""






End Sub

Display More

Code

Private Sub CommandButton7_Click()
Unload Entryform1
End Sub


Private Sub CommandButton8_Click()
Dim lr As Long
Application.ScreenUpdating = True
Sheets("NEW EQUIP REPAIRS").Select
Set findBlank = Range("A2:a20").Find(What:="", lookat:=xlWhole)
findBlank.Select
ActiveCell.Value = DTPicker7.Value
ActiveCell.Offset(0, 1).Value = TextBox14.Text




Sheets("NEW EQUIP REPAIRS").Range("A3:J20").Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes


End Sub

Display More

**S O** · Feb 7th 2021

Hi PMRetired2012, welcome to OzGrid. Hope you're keeping safe and. well.

Please familiarise yourself with the rules (found in my signature) regarding cross posting and code tags. I've done it for you on this occasion but please be mindful for the future.

Cheers,

Sam

PMRetired2012 · Feb 7th 2021

Any help on this post?

**Carim** · Feb 7th 2021

Hello,

The DatePicker is an additional control in the UserForm ToolBox ... (provided the DLL library is available on your computer)

see explanation :

External Content www.youtube.com

Content embedded from external sources will not be displayed without your consent.

Through the activation of external content, you agree that personal data may be transferred to third party platforms. We have provided more information on this in our privacy policy.

Should you have difficulties, depending on your own system or configuration ...

see https://www.ablebits.com/offic…xcel-datepicker-template/

Hope this will help

**royUK** · Feb 7th 2021

DatePickers are not available on many systems. I would never use one in any project, especially if it is to be used by others. This would mean checking that the DatePicker is installed on every machine to use it.

Take a look at my non-ActiveX alternatives.

Alternative DatePickers

**Carim** · Feb 7th 2021

Should you need a fully customizable datepicker solution ...

Trevor EYRE has done a very nice job

See :

https://trevoreyre.com/portfolio/excel-datepicker/

Hope this will help

**S O** · Feb 7th 2021

royUK for some reason your link doesn't seem to be working, I assume this is the page you were referring to: https://excel-it.com/store-datepickers.htm

PMRetired2012 for what it's worth I have used Roy's DatePicker on multiple projects and can fully endorse it

**royUK** · Feb 7th 2021

Thanks SO.

I don't know why it was working. I've replaced the link now.

PMRetired2012 · Feb 7th 2021

Guys my problem is how do i use these calanders in a userform? i dont know how to get them into the form and code it to where it will work.

Sorry but i need some detail instruction.

**royUK** · Feb 7th 2021

My CalendarForm has an example of how to use the Calendar form from a different userform

**Carim** · Feb 7th 2021

Quote from PMRetired2012

Guys my problem is how do i use these calanders in a userform? i dont know how to get them into the form and code it to where it will work.
Sorry but i need some detail instruction.

Attached is a very simple (quickly drafted) example : DatePicker in UserForm ... for your inspiration

Hope this will help

PMRetired2012 · Feb 8th 2021

Carim,

I looked at the userform you created for me. Did you have to make that calander userform that you had there or did the code you wrote make the calander userform?

Dennis

And thanks for the info !

**royUK** · Feb 8th 2021

JHave you not bothered looking at my example.?

frmTest shows how to use the CalendarForm from a differentUserForm This has been used 100s of times!

**Carim** · Feb 8th 2021

Quote from PMRetired2012

Carim,
I looked at the userform you created for me. Did you have to make that calander userform that you had there or did the code you wrote make the calander userform?

Dennis

And thanks for the info !

Display More

Hello Dennis,

Attached is your test file

Modifications were added for your TextBox13 ... you do need to replicate them for all your other 6 identical Text Boxes

Hope this will help

**Carim** · Feb 8th 2021

Once you have the tested the macro ... feel free to share your comments

PMRetired2012 · Feb 9th 2021

Wow Carim thank you !

Couple other thing that i was wondering about:

1. when i click that text box and the calender pops up can it be set up to where it will default to the current date and show up in the textbox?

2. can you explain the class modules to me and how they work? i did some research but didnt get much out of the research.

Thanks

Dennis

**Carim** · Feb 9th 2021

Glad to hear you are pleased

But ... your question leads me to believe you have not tested the UserForm ...!!!

PMRetired2012 · Feb 10th 2021

Carmin,

I did test the userform and i want to say thanks for helping me.

what i thought could possible happen when i opened the userform the date would show up in that textbox instead of haveing to click the textbox and the datepicker show up and me pick the date.

if it does that i didnt see it doing that and not sure that can happen either.

Thanks

**Carim** · Feb 10th 2021

Glad to hear you could fix your problem

Thanks for your Thanks

**royUK** · Feb 10th 2021

Do you mean like this?

Using Date picker in Visual Basic with a Userform

Participate now!

Share

Tags

Users Viewing This Thread