Using Date picker in Visual Basic with a Userform

PMRetired2012

Board Regular
Joined
Aug 6, 2019
Messages
123
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 try to attach the excel file if possible

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

VBA 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

'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

'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

'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

'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

'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

'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

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
 
Last edited by a moderator:
I don't have a Date Picker control in my copy of Excel's VBA so I don't think I can help you with that question. However, I did want to point out to you that you can load up a ComboBox with the upper case month name using a single line of code...
VBA Code:
ComboBox1.List = [UPPER(TEXT(28*ROW(1:12),"mmmm"))]
For other ComboBox lists, you can use the Array function with a comma delimited item list. For example, your category(?) list being assigned to ComboBox4 could be assigned with this one-line of code...
VBA Code:
ComboBox4.List = Array("UTILITY", "RESALE", "INSURANCE", "SUPPLIES", "TAXES", "CO2", "LICENSE", "EQUIPMENT", "MAINTENACE", "MEMBERSHIP", "LABOR", "REPAIRS", "MERCHANT LIC")
 
Upvote 0

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Goto the thread you started in Excel Forum & copy the URL from the URL & then paste that into a reply here.
 
Upvote 0
That's perfect, many thanks.
 
Upvote 0
I can't as I don't have the date picker controls on my version of Xl.
You maybe better off using one of the tools suggested on OzGrid.
 
Upvote 0
As I said in Message #11 (did you see it yet as it has something interesting for you to consider) and Fluff just said, we don't have a Date Picker control in our (different) versions of Excel. My question to you is why do you have a Date Picker control in yours? Did you add it independently? If so, tell us where you got it from and, if it is free, we can maybe add it to our versions of Excel and experiment with it with an eye to helping you with your question.
 
Upvote 0
Do you think anyone can help me with this?

There are lots here that can help you but need to be mindful all are volunteers and just sometime need to be a little patient awaiting a response - also, mulit cross posting puts some off responding

I have have a glance at your codes and from what I can determine, the Intialize event codes are showing references to Comboboxes with Month names listed - are these these your date picker controls and am I correct in thinking that it is these you want to set to the current month when form displayed?

If this is so, You can try this update to your Intialize event & see if it does what you want

VBA Code:
Private Sub UserForm_Initialize()
    Dim i               As Integer
    Dim arr(1 To 12)    As Variant
    Dim wsOptionsPage   As Worksheet
   
    Set wsOptionsPage = ThisWorkbook.Worksheets("OPTIONS PAGE")
   
    For i = 1 To 12
        arr(i) = MonthName(i, False)
    Next i
   
    For i = 1 To 11
        With Me.Controls("ComboBox" & i)
            Select Case i
                Case 3
                    .List = wsOptionsPage.Range("C2", _
                            wsOptionsPage.Cells(wsOptionsPage.Rows.Count, "C").End(xlUp)).Value
                Case 4
                    .List = Array("UTILITY", "RESALE", "INSURANCE", "SUPPLIES", "TAXES", "CO2", "LICENSE", _
                                  "EQUIPMENT", "MAINTENACE", "MEMBERSHIP", "LABOR", "REPAIRS", "MERCHANT LIC")
                Case 6
                    .List = Array("Sandy", "Kim")
                Case 10
                    .List = Array("21.00", "35.00", "38.50", "42.00", "77.00")
                Case 11
                    .List = wsOptionsPage.Range("G2", _
                            wsOptionsPage.Cells(wsOptionsPage.Rows.Count, "G").End(xlUp)).Value
                Case Else
                    .List = arr
                    .Value = Format(Date, "mmmm")
            End Select
        End With
    Next
End Sub

if you are using datepicker control in your project you should note that DatePicker control is not available in all Excel versions. Personally, I would avoid using them for this reason, especially if the application is to be shared with others. If you want to have a datepicker style input form, then suggest search for one of the many “home brew” versions people have created using a userform that you can download for free.

Hope this helps but if not and as already requested, please provide more detail about your project as this would be help the forum.


Dave
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,288
Members
448,563
Latest member
MushtaqAli

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top