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
 
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
359
krunal123
K
G
  • Question Question
Move the selected item up one position in the list Userform ListBox
Replies
4
Views
205
giri u
G
S
  • Question Question
Move files from folder to another folder based on listbox file names Selected
Replies
7
Views
348
John_w
J
I
  • Solved
Search worksheet for with a changeable column search
Replies
4
Views
118
mumps
mumps
I
  • Question Question
Run time erorr 94 when selecting value in Listbox
Replies
4
Views
137
ipbr21054
I

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