Date format changing when userform edited

GillG

New Member
Joined
Oct 10, 2017
Messages
1
Hi

I wonder f someone could provide me with some help and advice please?

I have a userform to add, edit and delete data on a worksheet. It all works fine apart from the date format changes when the userform is edited. When I change any of the controls in the userform (name etc) the dates change from "dd/mm/yyyy" format to "mm/dd/yyyy" format.

I have the following code to ensure that the user enters a date in "dd/mm/yyyy" format when the details are added in the userform and I have this set for each of the controls that are date values:

Code:
Private Sub Reg6_AfterUpdate()
Dim DateEntered As Date
If Me.Reg6.Value <> "" Then
DateEntered = -1 '-1 will signal bad date entry (cannot convert)
On Error Resume Next 'Disable System Error Messages
DateEntered = CDate(Me.Reg6.Value)
On Error GoTo 0 'Enable System Error Messages
If DateEntered <> -1 Then 'Valid Entry
'Toggle red means there is an error(s); Black means all is normal
Me.DOBLabel.ForeColor = RGB(0, 0, 0) 'Black
Me.Reg6.ForeColor = RGB(0, 0, 0) 'Black
' Format User data
Me.Reg6.Value = Format(Me.Reg6.Value, "dd/mm/yyyy")
'Determine if ErrorMessageLabel can be "turned off"
'We should not turn off ErrorMessageLabel if there are other errors on the form
If ScanForLabels() = False Then
Me.ErrorMessageLabel.Visible = False
Else
Me.ErrorMessageLabel.Visible = True
End If
Else 'Invalid Entry
Me.DOBLabel.ForeColor = RGB(255, 0, 0) 'Red
Me.Reg6.ForeColor = RGB(255, 0, 0) 'Red
Me.ErrorMessageLabel.Visible = True
End If
Else 'User Clears text box
Me.DOBLabel.ForeColor = RGB(0, 0, 0) 'Black
Me.Reg6.ForeColor = RGB(0, 0, 0) 'Black
'Determine if ErrorMessageLabel can be "turned off"
'We should not turn off ErrorMessageLabel if there are other errors on the form
If ScanForLabels() = False Then
Me.ErrorMessageLabel.Visible = False
Else
Me.ErrorMessageLabel.Visible = True
End If
End If
End Sub


[COLOR=#252C2F][FONT=Helvetica]
[/FONT][/COLOR]I have the following code to highlight the relevant labels to red if the date entry is not in the correct format 

[Code]
Private Function ScanForLabels() As Boolean
'This function scans the form for red labels indicating an error on the page
'There will always be at least one red label since ErrorMessageLabel is set to red by default
'False = No Errors Detected
'True = Errors Detected
Dim CtrlInForm As Control 'controls on the form
Dim CountErrorLabels As Integer 'count of red error labels
CountErrorLabels = 0 'set to zero to start
'Loop - if the control is a label, it checks to see if it is red
'If so, it increments the CountErrorLabels variable
For Each CtrlInForm In Me.Controls
If TypeName(CtrlInForm) = "Label" Then
If CtrlInForm.ForeColor = RGB(255, 0, 0) Then 'if it's red...
CountErrorLabels = CountErrorLabels + 1
End If
End If
Next CtrlInForm
'If there is only one red label (ErrorMessageLabel), return FALSE as all data entry is valid
'Otherwise return TRUE
If CountErrorLabels = 1 Then
ScanForLabels = False
Else
ScanForLabels = True
End If
End Function

This is the code I have for when the edit button is clicked. All of the relevant cells overwrite as expected, except the date

Code:
Private Sub cmdEdit_Click()
'delcare the variables
Dim findvalue As Range
Dim FullName As String
Dim DateEntered As Date 'will contain date entered by user

'identify the value of FullName
FullName = Me.Reg4.Value & " " & UCase(Me.Reg3.Value)

'error handling
On Error GoTo errHandler:
'check for values
If Reg1.Value = "" Or Reg2.Value = "" Then
    MsgBox "There is no data to edit"
    Exit Sub
End If
'edit the row
Set findvalue = Sheet1.Range("C:C").Find(What:=Reg2, LookIn:=xlValues, LookAt:=xlWhole)
'if the edit is a name then add it
Me.Reg5.Value = Me.Reg4.Value + " " + UCase(Me.Reg3.Value)

findvalue = Reg2.Value
findvalue.Offset(0, 1) = Reg3.Value
findvalue.Offset(0, 2) = Reg4.Value
findvalue.Offset(0, 3) = Reg5.Value
findvalue.Offset(0, 4) = Reg6.Value
findvalue.Offset(0, 5) = Reg7.Value
findvalue.Offset(0, 6) = Reg8.Value
findvalue.Offset(0, 7) = Reg9.Value
findvalue.Offset(0, 8) = Reg10.Value
findvalue.Offset(0, 9) = Reg11.Value
findvalue.Offset(0, 10) = Reg12.Value
findvalue.Offset(0, 11) = Reg13.Value
findvalue.Offset(0, 12) = Reg14.Value
findvalue.Offset(0, 13) = Reg15.Value
findvalue.Offset(0, 14) = Reg16.Value
findvalue.Offset(0, 15) = Reg17.Value
findvalue.Offset(0, 16) = Reg18.Value
findvalue.Offset(0, 17) = Reg19.Value
findvalue.Offset(0, 18) = Reg20.Value
findvalue.Offset(0, 19) = Reg21.Value
findvalue.Offset(0, 20) = Reg22.Value
findvalue.Offset(0, 21) = Reg23.Value


'clear the values in the reg controls
cNum = 23
    For X = 1 To cNum
        Me.Controls("Reg" & X).Value = ""
        Me.TxtLookup = ""

'refresh the listbox
Next
Lookup

'communicate with the user
MsgBox FullName & " was edited successfully", 0, "Complete"   'message to say client has been added to the database

Exit Sub
'error block
On Error GoTo 0
Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub

I also have a listbox and the following code to populate the controls when the listox is double clicked:

Code:
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declre the variables
Dim cRef As String
Dim I As Integer
Dim findvalue

'error block
On Error GoTo errHandler:
'get the value from the listbox
For I = 0 To lstLookup.ListCount - 1
    If lstLookup.Selected(I) = True Then
    cRef = lstLookup.List(I, 6)
End If
Next I
'find the ref number
Set findvalue = Sheet1.Range("C:C").Find(What:=cRef, LookIn:=xlValues).Offset(0, -1)
'add the database values to the userform

cNum = 23
For X = 1 To cNum
    Me.Controls("Reg" & X).Value = findvalue
    Set findvalue = findvalue.Offset(0, 1)
Next
'disable adding new client
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
'error block
On Error GoTo 0
Exit Sub
errHandler::
    MsgBox "An Error has Occurred  " & vbCrLf & "The error number is:  " _
           & Err.Number & vbCrLf & Err.Description & vbCrLf & _
           "Please notify the administrator"
End Sub
I don't know if it is the edit button or double clicking the listbox that is changing the date format?

Any help or advice you could offer would be much appreciated 

Thanks very much

Gill
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Forum statistics

Threads
1,224,820
Messages
6,181,160
Members
453,021
Latest member
Justyna P

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