Adding Date to UserForm with Calendar Date selection

N

nimesh29

New Member
Joined
Mar 20, 2013
Messages
26
Hi,
Looking to add add to Userform TextBox, I have calendar popup with double click in the textbox but, once i select the date i am having hard time getting date to insert in the Text box. I have five different text box that i need to add date to so, want to keep them consistent.

Also, is there a way to add command button inside the Textbox, on the right side. to avoid having command button next to text box.

Link to File:
http://we.tl/YiP3OqrgpB


Code: 
Private Sub Cmdbutton1_Click()
If TextBox15 = 0 Then
Exit Sub
End If
If ListBox1.ListIndex = 0 Then
MsgBox "First Record", vbCritical
Exit Sub
Else
TextBox15 = TextBox15 - 1
With Me.ListBox1
        .ListIndex = .ListIndex - 1
End With
End If
End Sub


Private Sub Cmdbutton2_Click()
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then
MsgBox "Last Record", vbCritical
Exit Sub
Else
TextBox15 = TextBox15 + 1
With Me.ListBox1
        .ListIndex = .ListIndex + 1
End With
End If
End Sub


Private Sub Cmdbutton3_Click() 'FIRST RECORD BUTTON
ListBox1.ListIndex = 0
End Sub


Private Sub Cmdbutton4_Click() 'LAST RECORD BUTTON
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub


Private Sub CommandButton1_Click() 'Saving Button
Dim sonsat As Long


If TextBox1.Value = "" Then
        MsgBox "Please enter a First Name.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
    If TextBox2.Value = "" Then
        MsgBox "Please enter a CSI Number.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
    If TextBox3.Value = "" Then
        MsgBox "Please enter a Consultant.", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
If TextBox10.Value = "" Then
        MsgBox "Please enter a Return Date.", vbExclamation
        TextBox10.SetFocus
        Exit Sub
    End If
'    If TextBox12.Value = "" Then
 '       MsgBox "Please enter Estimated Revenue.", vbExclamation
 '       TextBox12.SetFocus
  '      Exit Sub
  '  End If
   
  '  If Not IsNumeric(TextBox12.Text) Then
   '     MsgBox "Please enter a Numeric Value.", vbExclamation
   '     TextBox12.SetFocus
   '     Exit Sub
   ' End If
sonsat = Sheets("Data").[a65536].End(3).Row + 1
Call Main 'Progress Bar


Cells(sonsat, 1) = TextBox1
Cells(sonsat, 2) = TextBox2
Cells(sonsat, 3) = TextBox3
Cells(sonsat, 4) = TextBox4
Cells(sonsat, 5) = TextBox5
Cells(sonsat, 6) = TextBox6
Cells(sonsat, 7) = TextBox7
Cells(sonsat, 8) = TextBox8
Cells(sonsat, 9) = TextBox9
Cells(sonsat, 10) = TextBox10
Cells(sonsat, 11) = TextBox11
Cells(sonsat, 12) = TextBox12


MsgBox "Registration is successful"
ListBox1.List = Sheets("Data").Range("a2:l" & [a65536].End(3).Row).Value 'For refresh listbox
TextBox14.Value = ListBox1.ListCount
End Sub


Private Sub CommandButton18_Click()


End Sub


Private Sub CommandButton19_Click() 'Load Consultant list
ConsultantUserform.Show


End Sub


Private Sub CommandButton2_Click() 'Update Button
Dim sonsat As Long


If ListBox1.ListIndex = -1 Then
MsgBox "Choose an item", vbExclamation
Exit Sub
End If
Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate
sonsat = ActiveCell.Row


Cells(sonsat, 1) = TextBox1.Text
Cells(sonsat, 2) = TextBox2.Text
Cells(sonsat, 3) = TextBox3.Text
Cells(sonsat, 4) = TextBox4.Text
Cells(sonsat, 5) = TextBox5.Text
Cells(sonsat, 6) = TextBox6.Text
Cells(sonsat, 7) = TextBox7.Text
Cells(sonsat, 8) = TextBox8.Text
Cells(sonsat, 9) = TextBox9.Text
Cells(sonsat, 10) = TextBox10.Text
Cells(sonsat, 11) = TextBox11.Text
Cells(sonsat, 12) = TextBox12.Text


Call Main 'Progress Bar
MsgBox "Item has been updated"
ListBox1.List = Sheets("Data").Range("a2:l" & [a65536].End(3).Row).Value 'For refresh listbox
End Sub


Private Sub CommandButton3_Click() ' Delete Button
   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
   MsgBox "Choose an entry", vbExclamation
   Exit Sub
   End If
   If ListBox1.ListIndex >= 0 Then
    cevap = MsgBox("Entry will be deleted. ... Are you sure ?", vbYesNo)
If cevap = vbYes Then
   Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate
sil = ActiveCell.Row
   Sheets("Data").Rows(sil).Delete
                     
        End If
        End If
 Call Main 'Progress Bar
       
For A = 1 To 12
Controls("textbox" & A) = ""
Next


ListBox1.List = Sheets("Data").Range("a2:l" & [a65536].End(3).Row).Value
TextBox14.Value = ListBox1.ListCount
End Sub


Private Sub CommandButton4_Click() 'CLEAR BUTTON
Dim del As Control
    For Each del In UserForm1.Controls
        If TypeName(del) = "TextBox" Or TypeName(del) = "ComboBox" Then
            del.Text = ""
        ElseIf TypeName(del) = "ListBox" Then
            del.Value = ""
       
        End If
    Next del
    Call Main 'Progress Bar
TextBox14.Value = ListBox1.ListCount
Label15.Caption = ""
UserForm_Initialize
End Sub


Private Sub CommandButton5_Click() 'Search Button
Dim sat, s As Long
Dim deg1, deg2 As String
If TextBox13.Value = "" Then
MsgBox "Please enter a value", vbExclamation
TextBox13.SetFocus
Exit Sub
End If


If ComboBox1.Value = "" Or ComboBox1.Value = "-" Then
MsgBox "Choose a filter field", vbExclamation
ComboBox1.SetFocus
Exit Sub
End If


For A = 1 To 12 ' Clear textboxes(1-12)
Controls("textbox" & A) = ""
Next
With ListBox1
.Clear
.ColumnCount = 12
.ColumnWidths = "45;140;110;65;65;35;40;65;65;115;150;65"
End With
Call Main 'Progress Bar


deg2 = TextBox13.Value
Select Case ComboBox1.Value
Case "RFI No:"
For sat = 2 To Cells(65536, "a").End(xlUp).Row
Set deg1 = Cells(sat, "a")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
s = s + 1
End If: Next


Case "CSI Section:"
For sat = 2 To Cells(65536, "b").End(xlUp).Row
Set deg1 = Cells(sat, "b")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
s = s + 1
End If: Next


Case "Consultant:"
For sat = 2 To Cells(65536, "d").End(xlUp).Row
Set deg1 = Cells(sat, "d")
If UCase(deg1) Like UCase(deg2) & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
s = s + 1
End If: Next




Case "Cost Implication:"
For sat = 2 To Cells(65536, "l").End(xlUp).Row
Set deg1 = Cells(sat, "l")
If deg1 Like deg2 & "*" Then
ListBox1.AddItem
ListBox1.List(s, 0) = Cells(sat, "A")
ListBox1.List(s, 1) = Cells(sat, "B")
ListBox1.List(s, 2) = Cells(sat, "C")
ListBox1.List(s, 3) = Cells(sat, "D")
ListBox1.List(s, 4) = Cells(sat, "E")
ListBox1.List(s, 5) = Cells(sat, "F")
ListBox1.List(s, 6) = Cells(sat, "G")
ListBox1.List(s, 7) = Cells(sat, "H")
ListBox1.List(s, 8) = Cells(sat, "I")
ListBox1.List(s, 9) = Cells(sat, "J")
ListBox1.List(s, 10) = Cells(sat, "K")
ListBox1.List(s, 11) = Cells(sat, "L")
s = s + 1
End If: Next
End Select


Label15.Caption = ListBox1.ListCount
End Sub


Private Sub CommandButton6_Click() 'Clear Search Textbox Button
TextBox13.Value = "": ComboBox1.Value = ""
ListBox1.List = Sheets("Data").Range("a2:l" & [a65536].End(3).Row).Value
Label15.Caption = ""
End Sub


Private Sub CommandButton7_Click() 'Close Button
Unload Me
End Sub


Private Sub CommandButton8_Click() 'Load CSI List
CSIUserform.Show
End Sub


Private Sub Label1_Click()


End Sub


Private Sub Label2_Click()


End Sub


Private Sub ListBox1_Click()
Dim say As Long, A As Byte


For A = 0 To 11
Controls("textbox" & A + 1) = ListBox1.Column(A)
Next


Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate
say = ActiveCell.Row
Sheets("Data").Range("A" & say & ":L" & say).Select
TextBox15 = ListBox1.ListIndex + 1
End Sub


Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex + 1
    End With
 End Sub


Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub


With Me.ListBox1
        .ListIndex = .ListIndex - 1
    End With
    End Sub


Private Sub TextBox11_Change()


End Sub


Private Sub TextBox15_Change()
TextBox15 = ListBox1.ListIndex + 1
End Sub


Private Sub TextBox2_Change()
  


End Sub


Private Sub TextBox3_Change()


End Sub


Private Sub textbox6_change()




End Sub




Private Sub TextBox6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
DatePickerForm.Show


End Sub


Private Sub TextBox9_Change()


End Sub


Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
    Application.Visible = False
   End If
   If ToggleButton1.Value = True Then
    Application.Visible = True
    
End If
End Sub


Private Sub UserForm_Initialize()


ListBox1.ColumnWidths = "45;110;85;150;35;65;65;65;65;65;150;65"         'COLUMN WITH OF LISTBOX
ListBox1.ColumnCount = 11                                                 'COLUMN NUMBER OF LISTBOX
ListBox1.List = Sheets("Data").Range("A2:l" & [a65536].End(3).Row).Value


'** SEARCH COMBOBOX
ComboBox1.AddItem "RFI No:"
ComboBox1.AddItem "CSI Section:"
ComboBox1.AddItem "Consultant:"
'ComboBox1.AddItem "Cost Implication:"
'**********************************************


TextBox14.Value = ListBox1.ListCount
TextBox15.Value = 0
With lblDone ' set the "progress bar" to it's initial length
        .Top = lblRemain.Top + 1
        .Left = lblRemain.Left + 1
        .Height = lblRemain.Height - 2
        .Width = 0
    End With
lblPct.Visible = False


'************************************************


 ' Open DatePicker
    'Set DatePickerForm.TextBox6.Value = DatePickerForm.TextBox6.Value
    'Target = Target.Cells(1, 1)
    'DatePickerForm.Show vbModal
  '  Cancel = True
   ' End If
    'call cCalendar
 'textBox6.Value = Calendar1.Value 'Format(Date, "dd.mm.yyyy")


End Sub
' PROGRESS BAR CODES
Sub Main()
Dim i As Long, tot As Long
     tot = 10000
     For i = 1 To tot
        If i Mod 5 = 0 Then ProgressBar i / tot
        ' do something
    Next i
   
   Call Back
     End Sub


Sub ProgressBar(PctDone As Single)
    With UserForm1
        .lblDone.Width = PctDone * (.lblRemain.Width - 2)
        .lblPct.Visible = True
        .lblPct.Caption = Format(PctDone, "0%")
    End With
    
    Select Case UserForm1.lblPct.Caption
    Case "10%"
        UserForm1.Frame5.Visible = True
           
    Case "20%"
        UserForm1.Frame6.Visible = True
                
    Case "30%"
        UserForm1.Frame7.Visible = True
        
    Case "40%"
       UserForm1.Frame8.Visible = True
       
    Case "50%"
       UserForm1.Frame9.Visible = True
            
    Case "60%"
        UserForm1.Frame10.Visible = True
            
    Case "70%"
     UserForm1.Frame11.Visible = True
           
    Case "80%"
     UserForm1.Frame12.Visible = True
        
    Case "90%"
       UserForm1.Frame13.Visible = True
                
    Case "100%"
      UserForm1.Frame14.Visible = True
                
    End Select
    DoEvents
 
End Sub
' END OF PROGRESS BAR CODES
Sub Back()
For A = 5 To 14
Controls("Frame" & A).Visible = False
Next
lblDone.Width = 0
lblPct.Visible = False
End Sub

Thanks for your help.
Nimesh
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

C
  • Question
A Bookmark to return to the same row when exiting and opening the application
Replies
8
Views
152
Edgar_
Edgar_
T
  • Question
Filter data in listbox based on three conditions by selected from combobox
Replies
1
Views
155
tubrak
T
C
  • Question
Porting an Excel application to Access
Replies
6
Views
229
chazrab
C
A
  • Solved
Exclude columns in listbox on userform except first two columns & last column
2
Replies
16
Views
331
abdelfattah
A
P
  • Solved
Listbox2 value send email
Replies
9
Views
248
Domenic
D

Forum statistics

Threads
1,214,589
Messages
6,120,415
Members
448,960
Latest member
AKSMITH

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