I have a problem with the date format in a user form that is searching and updating existing records.
I am using the following code for a "search and update" form. The user enters dates in UK format (dd/mm/yyyy) but they are displaying in the data sheet in US format (mm/dd/yyyy) which is causing problems. In my other "add record" form I have used CDATE but can't work out how to do it in the "search and update" form.
I have NO VBA experience and have did a simple cut and paste to get this code from the internet so am not quite sure how I have made it this far!!
Option Explicit
Dim Where As Range
Dim LastFind As Range
Private Sub UserForm_Initialize()
'Setup the Tag property for easier access
TextBoxRMS.Tag = "A"
ComboBoxContract.Tag = "B"
ComboBoxOfficer.Tag = "C"
ComboBoxFaculty.Tag = "D"
ComboBoxSchool.Tag = "E"
TextBoxDateRec.Tag = "F"
Me.TextBoxDateAct.Tag = "G"
Me.TextBoxNgComp.Tag = "H"
Me.TextBoxAdminRec.Tag = "I"
Me.TextBoxAdminRet.Tag = "J"
Me.TextBoxCodeGen.Tag = "L"
Me.TextBoxEmail.Tag = "M"
Me.TextBoxAddInfo.Tag = "R"
'Setup a range to search
Set Where = Worksheets("Data").Columns("A")
End Sub
Private Sub ClearForm()
'Clears every control that has a Tag property
Dim C As Control
For Each C In Me.Controls
If C.Tag <> "" Then C.Value = ""
Next
Set LastFind = Nothing
End Sub
Private Sub FillForm()
'Fills every control that has a Tag property
Dim C As Control
For Each C In Me.Controls
If C.Tag <> "" Then
'Fill the textbox from the column specified by the Tag property
C.Value = Intersect(LastFind.EntireRow, LastFind.Parent.Columns(C.Tag))
End If
Next
End Sub
Private Sub SaveForm()
'Copy the data to the database
Dim C As Control
For Each C In Me.Controls
If C.Tag <> "" Then
Intersect(LastFind.EntireRow, LastFind.Parent.Columns(C.Tag)) = C.Value
End If
Next
End Sub
Private Sub cbFindNext_Click()
'Commandbutton "FindNext"
If LastFind Is Nothing Then
Set LastFind = Where.Find(Me.TextBoxRMS, LookIn:=xlValues, LookAt:=xlPart)
Else
Set LastFind = Where.FindNext(LastFind)
End If
If LastFind Is Nothing Then ClearForm Else FillForm
End Sub
Private Sub cbFindPrev_Click()
'Commandbutton "FindPrevious"
If LastFind Is Nothing Then
Set LastFind = Where.Find(TextBoxRMS, LookIn:=xlValues, LookAt:=xlPart)
Else
Set LastFind = Where.FindPrevious(LastFind)
End If
If LastFind Is Nothing Then ClearForm Else FillForm
End Sub
Private Sub CommandButtonUpdate_Click()
If LastFind Is Nothing Then
'Find first empty row in database
Set LastFind = Where.Cells(Where.Cells.Count).End(xlUp).Offset(1)
End If
MsgBox "Record Successfully Updated"
SaveForm
ClearForm
End Sub
Private Sub CommandButtonClear_Click()
Unload Me
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Exit button!"
End If
End Sub
Private Sub CommandButtonAdd_Click()
NewContractEntry.Show
End Sub
Private Sub CommandButtonClearData_Click()
'Clears every control that has a Tag property
Dim C As Control
For Each C In Me.Controls
If C.Tag <> "" Then C.Value = ""
Next
Set LastFind = Nothing
End Sub
Bookmarks