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:

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Using Date picker in Visual Basic with a Userform - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0
Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Using Date picker in Visual Basic with a Userform - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
Fluff, what am i suppost to do to get this answered?? I also posted in Excel Forum.
Why is that such a problem all i want is an answer to the question. I relize there might not be a answer also.
so i guess you arent going to answer my question bucause i cross posted??
Please advise.

Thanks
Dennis
 
Upvote 0
Please post the link to your question on Excel Forum as per board rules.
I wouls suggest that you also post links on Ef & Ozgrid as they have the sames rules regarding cross posting as we do.
 
Upvote 0
Please post the link to your question on Excel Forum as per board rules.
I wouls suggest that you also post links on Ef & Ozgrid as they have the sames rules regarding cross posting as we do.
Ok so Fluff what yiu are saying NO ONE will answer this??
And what do yiu me post links. I'm sorry but whT is the problem here im only asking a question to 3 diffrent sources. And how do you k ow I posted on other sites? I'm not trying to be a horses butt lol
Thanks
 
Upvote 0
Firstly I would suggest you read the rules &
Be sure to follow & read the link at the end of the rule too!
That way you would understand.

Ok so Fluff what yiu are saying NO ONE will answer this??
No I'm not saying that, anyone can help if they so wish. What I am asking you to do is to comply with the rules & post a link to your thread on Excel Forum.
 
Upvote 0
Fluff
I don't understand what you are talking about links or tags. I do nt know how to do that. I haven't done that before.
Let's just get to the point can you help me??
 
Upvote 0

Forum statistics

Threads
1,224,829
Messages
6,181,224
Members
453,025
Latest member
Hannah_Pham93

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