Using Date picker in Visual Basic with a Userform

P

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:
Sort by date Sort by votes

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
You must log in or register to reply here.

Similar threads

I
  • Solved
Also have the row number shown in Listbox on userform advice
Replies
7
Views
76
NoSparks
N
R
  • Question Question
Macro not working after adding two new items
Replies
5
Views
441
regan_2000
R
I
  • Solved
Edit working code to look for value after a date & before a date
Replies
6
Views
116
Alex Blakenburg
A
I
  • Solved
Simplify my working code please
Replies
7
Views
166
ipbr21054
I
R
  • Question Question
Runtime Error 91
2
Replies
15
Views
637
rtr1811
R

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

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