K
KevHardy
Hi,
I have a userform to record a new clients details (code shown below).
My problem is that, despite trying to make sure the date format is
dd/mm/yyyy when the data is entered on the worksheet it is in mm/dd/yyyy.
The date displays correctly on the userform and the columns are formatted a
dd/mm/yyyy.
Any ideas what's going wrong and how to fic it?
Cide:
Option Explicit
Private Sub CommandButtonCancel_Click()
Unload Me
End Sub
Private Sub CommandButtonClear_Click()
Dim ctl As Control
Me.TextDateRec.SetFocus
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub CommandButtonAdd_Click()
Dim iRow As Long
Dim ctl As Control
Dim ws As Worksheet
Set ws = Worksheets("Allocations")
'Check user inputs
If Me.TextName1.Value = "" Then
MsgBox "Please enter a First Name"
Me.TextName1.SetFocus
Exit Sub
End If
If Me.TextName2.Value = "" Then
MsgBox "Please enter a Surname"
Me.TextName2.SetFocus
Exit Sub
End If
If Me.TextSwift.Value = "" Then
MsgBox "Please enter a Swift Number"
Me.TextSwift.SetFocus
Exit Sub
End If
If Me.TextDateAdd = "" Then
MsgBox "Please enter a Date"
Me.TextDateAdd.SetFocus
Exit Sub
End If
If Me.TextDateRec.Value = "" Then
MsgBox "Please enter a Date"
Me.TextDateRec.SetFocus
Exit Sub
End If
If Me.TextReason.Value = "" Then
MsgBox "Please enter a Reason for Referral"
Me.TextReason.SetFocus
Exit Sub
End If
If Me.TextNeed.Value = "" Then
MsgBox "Please enter a Primary Need from the drop-down list"
Me.TextNeed.SetFocus
Exit Sub
End If
If Me.TextTime.Value = "" Then
MsgBox "Please enter a Timescale for Allocation from the drop-down list"
Me.TextTime.SetFocus
Exit Sub
End If
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Me.TextDateAdd.SetFocus
'copy the data to the database
ws.Cells(iRow, 1).Value = TextDateAdd
ws.Cells(iRow, 2).Value = Me.TextName2.Value + ", " + Me.TextName1.Value
ws.Cells(iRow, 3).Value = Me.TextSwift.Value
ws.Cells(iRow, 4).Value = Me.TextDateRec.Value
ws.Cells(iRow, 5).Value = Me.TextReason.Value
ws.Cells(iRow, 6).Value = Me.TextNeed.Value
ws.Cells(iRow, 7).Value = Me.TextTime.Value
ws.Cells(iRow, 9).Value = ""
ws.Cells(iRow, 10).Value = ""
'clear the data
Me.TextDateAdd.Value = ""
Me.TextName1.Value = ""
Me.TextSwift.Value = ""
Me.TextDateRec.Value = ""
Me.TextReason.Value = ""
Me.TextNeed.Value = ""
Me.TextTime.Value = ""
Unload Me
MsgBox "Client has been added to the Awaiting Allocations spreadsheet"
End Sub
'Check date formats
Private Sub TextDateAdd_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextDateAdd) Then
Cancel = True
Else
TextDateAdd = Format(TextDateAdd, "dd/mm/yyyy")
End If
End Sub
Private Sub TextDateRec_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextDateRec) Then
Cancel = True
Else
TextDateRec = Format(TextDateRec, "dd/mm/yyyy")
End If
End Sub
I have a userform to record a new clients details (code shown below).
My problem is that, despite trying to make sure the date format is
dd/mm/yyyy when the data is entered on the worksheet it is in mm/dd/yyyy.
The date displays correctly on the userform and the columns are formatted a
dd/mm/yyyy.
Any ideas what's going wrong and how to fic it?
Cide:
Option Explicit
Private Sub CommandButtonCancel_Click()
Unload Me
End Sub
Private Sub CommandButtonClear_Click()
Dim ctl As Control
Me.TextDateRec.SetFocus
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub CommandButtonAdd_Click()
Dim iRow As Long
Dim ctl As Control
Dim ws As Worksheet
Set ws = Worksheets("Allocations")
'Check user inputs
If Me.TextName1.Value = "" Then
MsgBox "Please enter a First Name"
Me.TextName1.SetFocus
Exit Sub
End If
If Me.TextName2.Value = "" Then
MsgBox "Please enter a Surname"
Me.TextName2.SetFocus
Exit Sub
End If
If Me.TextSwift.Value = "" Then
MsgBox "Please enter a Swift Number"
Me.TextSwift.SetFocus
Exit Sub
End If
If Me.TextDateAdd = "" Then
MsgBox "Please enter a Date"
Me.TextDateAdd.SetFocus
Exit Sub
End If
If Me.TextDateRec.Value = "" Then
MsgBox "Please enter a Date"
Me.TextDateRec.SetFocus
Exit Sub
End If
If Me.TextReason.Value = "" Then
MsgBox "Please enter a Reason for Referral"
Me.TextReason.SetFocus
Exit Sub
End If
If Me.TextNeed.Value = "" Then
MsgBox "Please enter a Primary Need from the drop-down list"
Me.TextNeed.SetFocus
Exit Sub
End If
If Me.TextTime.Value = "" Then
MsgBox "Please enter a Timescale for Allocation from the drop-down list"
Me.TextTime.SetFocus
Exit Sub
End If
'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row
Me.TextDateAdd.SetFocus
'copy the data to the database
ws.Cells(iRow, 1).Value = TextDateAdd
ws.Cells(iRow, 2).Value = Me.TextName2.Value + ", " + Me.TextName1.Value
ws.Cells(iRow, 3).Value = Me.TextSwift.Value
ws.Cells(iRow, 4).Value = Me.TextDateRec.Value
ws.Cells(iRow, 5).Value = Me.TextReason.Value
ws.Cells(iRow, 6).Value = Me.TextNeed.Value
ws.Cells(iRow, 7).Value = Me.TextTime.Value
ws.Cells(iRow, 9).Value = ""
ws.Cells(iRow, 10).Value = ""
'clear the data
Me.TextDateAdd.Value = ""
Me.TextName1.Value = ""
Me.TextSwift.Value = ""
Me.TextDateRec.Value = ""
Me.TextReason.Value = ""
Me.TextNeed.Value = ""
Me.TextTime.Value = ""
Unload Me
MsgBox "Client has been added to the Awaiting Allocations spreadsheet"
End Sub
'Check date formats
Private Sub TextDateAdd_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextDateAdd) Then
Cancel = True
Else
TextDateAdd = Format(TextDateAdd, "dd/mm/yyyy")
End If
End Sub
Private Sub TextDateRec_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TextDateRec) Then
Cancel = True
Else
TextDateRec = Format(TextDateRec, "dd/mm/yyyy")
End If
End Sub