DD/MM/YYYY in Userform

[HPFruity]

Hi all,

I'm having an issue whereby my userform pulls dates in a MM/DD/YYYY format. I have looked at different fixes to this on the web but am stuck with my codes.

I have pasted my userform code below to help locate where I can best put this fix. I'm no expert so please excuse any long winded code that could be shorter. The only issue I currently have is dates keep changing to MM/DD/YYYY strangley only when its possibly to do so. for e.g. if I type 15/05/2020 it stays as DD/MM/YYYY I assume because its impossible to make this MM/DD/YYYY. If there is anything else in this code that could be better please do let me know.

My Worksheet has the correct format but the userform then tries to switch to MM/DD/YYYY where it can so I assume I can rule out the worksheet and my PC is as per UK time and date reference as are my excel cells format.

Option Explicit
'Private variables
Dim cNum As Integer
Dim X As Integer
Public MyEntryBoxes As Collection

Private Sub cmdAdd_Click()
Dim nextrow As Range
'error handler
On Error GoTo ErrHandler:
'set the next row in the database
cmdAdd.BackColor = vbWhite
cmdAdd.ForeColor = vbBlack
Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
'check for values in the first 4 controls
For X = 1 To 4
If Me.Controls("Reg" & X).Text = "" Then
MsgBox "You must add all data"
Exit Sub
End If
Next
'check for duplicate payroll numbers
If WorksheetFunction.CountIf(Sheet2.Range("C:C"), Me.Reg1.value) > 0 Then
MsgBox "This staff member already exists"
Exit Sub
End If
'number of controls to loop through
cNum = 108
'add the data to the database
For X = 1 To cNum
nextrow = Me.Controls("Reg" & X).Text
Set nextrow = nextrow.Offset(0, 1)
Next
'clear the controls
For X = 1 To cNum
Me.Controls("Reg" & X).value = ""
Next
'sort the database
SortName
'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
Private Sub cmdAdd_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdAdd.BackColor = vbBlack
cmdAdd.ForeColor = vbWhite
End Sub
Private Sub cmdClose_Click()
Application.ScreenUpdating = False
Unload Me
Protect_All
Application.ScreenUpdating = True
End Sub
Private Sub cmdData_Click()
Sheet2.Select
End Sub
Sub Lookup()
'declare the variables
Dim rngFind As Range
Dim strFirstFind As String
'error statement
On Error GoTo ErrHandler:
'clear the listbox
lstLookup.Clear
'look up parts or all of full mname
With Sheet2.Range("mytable[Formal_Name]")
Set rngFind = .Find(txtLookup.Text, LookIn:=xlValues, lookat:=xlPart)
'if value found then set a variable for the address
If Not rngFind Is Nothing Then
strFirstFind = rngFind.Address
'add the values to the listbox
Do
If rngFind.Row > 1 Then
lstLookup.AddItem rngFind.Text
lstLookup.List(lstLookup.ListCount - 1, 1) = rngFind.Offset(0, -4)
lstLookup.List(lstLookup.ListCount - 1, 2) = rngFind.Offset(0, 3)
lstLookup.List(lstLookup.ListCount - 1, 3) = rngFind.Offset(0, 4)
lstLookup.List(lstLookup.ListCount - 1, 4) = rngFind.Offset(0, 5)
lstLookup.List(lstLookup.ListCount - 1, 5) = rngFind.Offset(0, 7)
lstLookup.List(lstLookup.ListCount - 1, 6) = rngFind.Offset(0, 8)
lstLookup.List(lstLookup.ListCount - 1, 7) = rngFind.Offset(0, 9)
lstLookup.List(lstLookup.ListCount - 1, 8) = rngFind.Offset(0, 104)
End If
'find the next address to add
Set rngFind = .FindNext(rngFind)
Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
End If
End With
'disable payroll editing
Me.Reg1.Enabled = False
Me.cmdEdit.Enabled = False
'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
Private Sub cmdDelete_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdDelete.BackColor = vbBlack
cmdDelete.ForeColor = vbWhite
End Sub
Private Sub cmdEdit_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdEdit.BackColor = vbBlack
cmdEdit.ForeColor = vbWhite
End Sub
Private Sub cmdLookup_Click()
Lookup
cmdLookup.BackColor = vbWhite
cmdLookup.ForeColor = vbBlack
End Sub
Private Sub cmdLookup_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdLookup.BackColor = vbBlack
cmdLookup.ForeColor = vbWhite
End Sub
Private Sub cmdReset_Click()
'clear the Reg controls
cmdReset.BackColor = vbWhite
cmdReset.ForeColor = vbBlack
cNum = 108
For X = 1 To cNum
Me.Controls("Reg" & X).value = ""
Next
'enable adding new staff
Me.cmdAdd.Enabled = True
'enable adding new payroll number
Me.Reg1.Enabled = True
'clear the listbox
lstLookup.Clear
'clear the textbox
Me.txtLookup.value = ""
End Sub
Private Sub cmdReset_Exit(ByVal Cancel As MSForms.ReturnBoolean)
cmdReset.BackColor = vbBlack
cmdReset.ForeColor = vbWhite
End Sub
Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
Dim cPayroll As String
Dim i As Integer
Dim findvalue
'error block
'On Error GoTo ErrHandler:
'get the select value from the listbox
For i = 0 To lstLookup.ListCount - 1
If lstLookup.Selected(i) = True Then
cPayroll = lstLookup.List(i, 1)
End If
Next i
'find the payroll number
Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, 0)
'add the database values to the userform
cNum = 108
For X = 1 To cNum
Me.Controls("Reg" & X).Text = findvalue
Set findvalue = findvalue.Offset(0, 1)
Next
'disable adding
Me.cmdAdd.Enabled = False
Me.cmdEdit.Enabled = True
'training due?
If IsDate(Reg80.Text) Then
If CDate(Reg80.Text) < Date Then
MsgBox "Training 2 Overdue - Please Check The Training Tab"
End If
End If
If IsDate(Reg76.Text) Then
If CDate(Reg76.Text) < Date Then
MsgBox "Training 1 Overdue - Please Check The Training Tab"
End If
End If

'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
Private Sub cmdDelete_Click()
'declare the variables
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
'check for values
cmdDelete.BackColor = vbWhite
cmdDelete.ForeColor = vbBlack
If Reg1.value = "" Or Reg5.value = "" Then
MsgBox "There is not data to delete"
Exit Sub
End If
'give the user a chance to change their mind
cDelete = MsgBox("Are you sure that you want to delete this staff member", vbYesNo + vbDefaultButton2, "Are you sure????")
If cDelete = vbYes Then
'delete the row
Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=Reg1, LookIn:=xlValues)
findvalue.EntireRow.Delete
End If
'clear the controls
For X = 1 To cNum
Me.Controls("Reg" & X).value = ""
Next
'refresh the listbox
Lookup
End Sub
Private Sub cmdEdit_Click()
'declare the variables
Dim findvalue As Range
'error handling
On Error GoTo ErrHandler:
cmdEdit.BackColor = vbWhite
cmdEdit.ForeColor = vbBlack
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
'check for values
If Reg4.value = "" Or Reg3.value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
'edit the row
Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=Reg1, LookIn:=xlValues).Offset(0, 0)
'if the edit is a name then add it
Me.Reg5.value = Me.Reg4.value + " " + Me.Reg3.value

For X = 1 To cNum
findvalue = Me.Controls("Reg" & X).Text
Set findvalue = findvalue.Offset(0, 1)
Next
'refresh the listbox
Lookup
'error block
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
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
Private Sub Reg17_Change()
On Error GoTo errhnd
'PURPOSE: Limit TextBox inputs to Postive Whole Numbers
If Not IsNumeric(Reg17.Text) And Reg17.Text <> "" Then
If Len(Reg17.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg17.Text = Abs(Round(Left(Reg17.Text, Len(Reg17.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg17.Text = ""
End If
ElseIf Reg17.Text <> "" Then
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg3_Change()
'get the full name
Me.Reg5.value = Me.Reg4.value + " " + Me.Reg3.value
End Sub
Private Sub Reg32_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub

Private Sub Reg33_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub

Private Sub Reg34_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub

Private Sub Reg35_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub

Private Sub Reg36_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub

Private Sub Reg37_Change()
'Get Full Address
Me.Reg38.value = Me.Reg32.value + ", " + Me.Reg33.value + ", " + Me.Reg34.value + ", " + Me.Reg35.value + ", " + Me.Reg36.value + ", " + Me.Reg37.value
End Sub
Private Sub Reg4_Change()
'get the full name
Me.Reg5.value = Me.Reg4.value + " " + Me.Reg3.value
End Sub

Private Sub Reg62_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With Me.Reg62
If Not IsDate(.value) Then
.SetFocus
MsgBox "Enter a valid date"
Exit Sub
End If
End With
End Sub

Private Sub Reg75_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg75.Text) And Reg75.Text <> "" Then
If Len(Reg75.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg75.Text = Abs(Round(Left(Reg75.Text, Len(Reg75.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg75.Text = ""
End If
ElseIf Reg75.Text <> "" Then
'Ensure Positive and No Decimals
Reg75.Text = Abs(Round(Reg75.Text, 0))
End If
Exit Sub
errhnd:
End Sub

Private Sub Reg79_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg79.Text) And Reg79.Text <> "" Then
If Len(Reg79.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg79.Text = Abs(Round(Left(Reg79.Text, Len(Reg79.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg79.Text = ""
End If
ElseIf Reg79.Text <> "" Then
'Ensure Positive and No Decimals
Reg79.Text = Abs(Round(Reg79.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg83_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg83.Text) And Reg83.Text <> "" Then
If Len(Reg83.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg83.Text = Abs(Round(Left(Reg83.Text, Len(Reg83.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg83.Text = ""
End If
ElseIf Reg83.Text <> "" Then
'Ensure Positive and No Decimals
Reg83.Text = Abs(Round(Reg83.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg87_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg87.Text) And Reg87.Text <> "" Then
If Len(Reg87.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg87.Text = Abs(Round(Left(Reg87.Text, Len(Reg87.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg87.Text = ""
End If
ElseIf Reg87.Text <> "" Then
'Ensure Positive and No Decimals
Reg87.Text = Abs(Round(Reg87.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg91_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg91.Text) And Reg91.Text <> "" Then
If Len(Reg91.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg91.Text = Abs(Round(Left(Reg91.Text, Len(Reg91.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg91.Text = ""
End If
ElseIf Reg91.Text <> "" Then
'Ensure Positive and No Decimals
Reg91.Text = Abs(Round(Reg91.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg95_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg95.Text) And Reg95.Text <> "" Then
If Len(Reg95.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg95.Text = Abs(Round(Left(Reg95.Text, Len(Reg95.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg95.Text = ""
End If
ElseIf Reg95.Text <> "" Then
'Ensure Positive and No Decimals
Reg95.Text = Abs(Round(Reg95.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg99_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg99.Text) And Reg99.Text <> "" Then
If Len(Reg99.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg99.Text = Abs(Round(Left(Reg99.Text, Len(Reg99.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg99.Text = ""
End If
ElseIf Reg99.Text <> "" Then
'Ensure Positive and No Decimals
Reg99.Text = Abs(Round(Reg99.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg103_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg103.Text) And Reg103.Text <> "" Then
If Len(Reg103.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg103.Text = Abs(Round(Left(Reg103.Text, Len(Reg103.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg103.Text = ""
End If
ElseIf Reg103.Text <> "" Then
'Ensure Positive and No Decimals
Reg103.Text = Abs(Round(Reg103.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg54_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg54.Text) And Reg54.Text <> "" Then
If Len(Reg54.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg54.Text = Abs(Round(Left(Reg54.Text, Len(Reg54.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg54.Text = ""
End If
ElseIf Reg54.Text <> "" Then
'Ensure Positive and No Decimals
Reg54.Text = Abs(Round(Reg54.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg55_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg55.Text) And Reg55.Text <> "" Then
If Len(Reg55.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg55.Text = Abs(Round(Left(Reg55.Text, Len(Reg55.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg55.Text = ""
End If
ElseIf Reg55.Text <> "" Then
'Ensure Positive and No Decimals
Reg55.Text = Abs(Round(Reg55.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg56_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg56.Text) And Reg56.Text <> "" Then
If Len(Reg56.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg56.Text = Abs(Round(Left(Reg56.Text, Len(Reg56.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg56.Text = ""
End If
ElseIf Reg56.Text <> "" Then
'Ensure Positive and No Decimals
Reg56.Text = Abs(Round(Reg56.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg59_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg59.Text) And Reg59.Text <> "" Then
If Len(Reg59.Text) > 1 Then
'Remove Added Non-Numerical Character from Number
Reg59.Text = Abs(Round(Left(Reg59.Text, Len(Reg59.Text) - 1), 0))
Else
'Delete Single Non-Numerical Character
Reg59.Text = ""
End If
ElseIf Reg59.Text <> "" Then
'Ensure Positive and No Decimals
Reg59.Text = Abs(Round(Reg59.Text, 0))
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg15_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Reg15.value = Format(Reg15.value, "£#,##0.00")
End Sub
Private Sub Reg15_Change()
On Error GoTo errhnd
If Not IsNumeric(Reg15.Text) And Reg15.Text <> "" Then
If Len(Reg15.Text) > 1 Then
Reg15.Text = Abs(Round(Left(Reg15.Text, Len(Reg15.Text) - 1), 0))
Else
Reg15.Text = ""
End If
ElseIf Reg15.Text <> "" Then
End If
Exit Sub
errhnd:
End Sub
Private Sub Reg24_Change()
'Show £
Reg24.value = Format(Reg24.value, "£###,##")
End Sub
Private Sub txtLookup_enter()
txtLookup.BackColor = vbYellow
txtLookup.ForeColor = vbBlack
End Sub
Private Sub txtLookup_Exit(ByVal Cancel As MSForms.ReturnBoolean)
txtLookup.BackColor = vbBlack
txtLookup.ForeColor = vbWhite
End Sub

Private Sub Userform_Initialize()
On Error GoTo 0
Me.Label149.Caption = "Welcome " & Application.UserName
Dim i As Long
Dim aControl As MSForms.Control
Dim NewEntryBox As clsEntryBox
Set MyEntryBoxes = New Collection

For i = 1 To 108
Set aControl = Nothing
On Error Resume Next
Set aControl = Me.Controls("Reg" & i)
On Error GoTo 0
Select Case TypeName(aControl)
Case "ComboBox"
Set NewEntryBox = New clsEntryBox
Set NewEntryBox.MyComboBox = aControl
MyEntryBoxes.Add Item:=NewEntryBox
Case "TextBox"
Set NewEntryBox = New clsEntryBox
Set NewEntryBox.MyTextBox = aControl
MyEntryBoxes.Add Item:=NewEntryBox
End Select
Next i
Set NewEntryBox = Nothing
End Sub


Private Sub Userform_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.ScreenUpdating = False
StopTimer
Sheet1.Select
Protect_All
Application.ScreenUpdating = True
End Sub
Private Sub StopTime_Click()
Application.Run "StopTimer"
Unload Me
End Sub

Private Sub Userform_Activate()
Application.Run "StartTimer"
End Sub

 

[jasonb75]

Have you tried formatting the date as part of your code? For example, change

Textbox1.Value = Range("A1").Value

to

Texbox1.Value = Format(Range("A1").Value, "dd/mm/yyyy")

Not sure exactly what the equivalent version will be in your code, or where it will be found. If you post only the relevant code, properly formatted with code tags (Point B 3 in the forum guidelines) then I'll have another look for you, but I'm not going to spend my afternoon dredging through a few hundred lines of unrelated and unformatted code.

 

[HPFruity]

Fair point Jason,

I have pasted the code below formatted, I just assumed all the code would be useful to have in case I had something that was pre-existing somewhere else that was effecting it.

This part of code pulls the data into the userform:

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cPayroll As String
    Dim i As Integer
    Dim findvalue
    'error block
    'On Error GoTo ErrHandler:
    'get the select value from the listbox
    For i = 0 To lstLookup.ListCount - 1
        If lstLookup.Selected(i) = True Then
            cPayroll = lstLookup.List(i, 1)
        End If
    Next i
    'find the payroll number
    Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, 0)
    'add the database values to the userform
    cNum = 108
    For X = 1 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'disable adding
    Me.cmdAdd.Enabled = False
    Me.cmdEdit.Enabled = True
    'training due?
    If IsDate(Reg80.Text) Then
If CDate(Reg80.Text) < Date Then
 MsgBox "Training 2 Overdue - Please Check The Training Tab"
 End If
End If
If IsDate(Reg76.Text) Then
If CDate(Reg76.Text) < Date Then
 MsgBox "Training 1 Overdue - Please Check The Training Tab"
 End If
End If

    '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

This part adds the initial data:

Private Sub cmdAdd_Click()
    Dim nextrow As Range
    'error handler
    On Error GoTo ErrHandler:
    'set the next row in the database
    cmdAdd.BackColor = vbWhite
    cmdAdd.ForeColor = vbBlack
    Set nextrow = Sheet2.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    'check for values in the first 4 controls
    For X = 1 To 4
        If Me.Controls("Reg" & X).Text = "" Then
            MsgBox "You must add all data"
            Exit Sub
        End If
    Next
    'check for duplicate payroll numbers
    If WorksheetFunction.CountIf(Sheet2.Range("C:C"), Me.Reg1.value) > 0 Then
        MsgBox "This staff member already exists"
        Exit Sub
    End If
    'number of controls to loop through
    cNum = 108
    'add the data to the database
    For X = 1 To cNum
        nextrow = Me.Controls("Reg" & X).Text
        Set nextrow = nextrow.Offset(0, 1)
    Next
    'clear the controls
    For X = 1 To cNum
        Me.Controls("Reg" & X).value = ""
    Next
    'sort the database
    SortName
    '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

This part updates the data (not the first time):

Private Sub cmdEdit_Click()
'declare the variables
    Dim findvalue As Range
    'error handling
    On Error GoTo ErrHandler:
            cmdEdit.BackColor = vbWhite
    cmdEdit.ForeColor = vbBlack
  Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
    'check for values
    If Reg4.value = "" Or Reg3.value = "" Then
        MsgBox "There is not data to edit"
        Exit Sub
    End If
    'edit the row
    Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=Reg1, LookIn:=xlValues).Offset(0, 0)
    'if the edit is a name then add it
    Me.Reg5.value = Me.Reg4.value + " " + Me.Reg3.value
    
    For X = 1 To cNum
        findvalue = Me.Controls("Reg" & X).Text
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'refresh the listbox
    Lookup
    'error block
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
    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

 

[jasonb75]

So which part relates to this?

I'm having an issue whereby my userform pulls dates in a MM/DD/YYYY format.

The problem will most likely be the line that is pulling the date into the form.

 

[HPFruity]

That would be the first part of code I pasted, the other two add data to the worksheet

It is the Double click on the listbox part below:

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cPayroll As String
    Dim i As Integer
    Dim findvalue
    'error block
    'On Error GoTo ErrHandler:
    'get the select value from the listbox
    For i = 0 To lstLookup.ListCount - 1
        If lstLookup.Selected(i) = True Then
            cPayroll = lstLookup.List(i, 1)
        End If
    Next i
    'find the payroll number
    Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, 0)
    'add the database values to the userform
    cNum = 108
    For X = 1 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    'disable adding
    Me.cmdAdd.Enabled = False
    Me.cmdEdit.Enabled = True
    'training due?
    If IsDate(Reg80.Text) Then
If CDate(Reg80.Text) < Date Then
 MsgBox "Training 2 Overdue - Please Check The Training Tab"
 End If
End If
If IsDate(Reg76.Text) Then
If CDate(Reg76.Text) < Date Then
 MsgBox "Training 1 Overdue - Please Check The Training Tab"
 End If
End If

    '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

 

[jasonb75]

Your code is checking dates, but the way that you're adding them doesn't really allow for formatting.

You could try inserting this directly above the MsgBox line, but I'm not convinced that it will work as needed.

Reg80.Text =Format(Reg80.Text, "dd/mm/yyyy")

Do the same for Reg76.

 

[HPFruity]

Your code is checking dates, but the way that you're adding them doesn't really allow for formatting.

You could try inserting this directly above the MsgBox line, but I'm not convinced that it will work as needed.

Reg80.Text =Format(Reg80.Text, "dd/mm/yyyy")

Do the same for Reg76.

Hi Jason,

It did not work as first thought.

I have tried a variation to the code, slightly long but it works with the exception that now when I edit the database the userform fails to do so and reverts to the previous value.
for example Reg74 was 10/05/2020 then I type a day later and click Edit Sub it then reverts back to 10/05/2020. First code below is the new double click listbox lookup, the second the edit/udate command button.

Private Sub lstLookup_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'declare the variables
    Dim cPayroll As String
    Dim i As Integer
    Dim findvalue
    'error block
    'On Error GoTo ErrHandler:
    'get the select value from the listbox
    For i = 0 To lstLookup.ListCount - 1
        If lstLookup.Selected(i) = True Then
            cPayroll = lstLookup.List(i, 1)
        End If
    Next i
    'find the payroll number
    Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=cPayroll, LookIn:=xlValues).Offset(0, 0)
    'add the database values to the userform
    cNum = 8
    For X = 1 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    For X = 9 To 9
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
   Reg9.Text = Format(Reg9.Text, "dd/mm/yyyy")
    cNum = 28
    For X = 10 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    For X = 29 To 29
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Reg29.Text = Format(Reg29.Text, "dd/mm/yyyy")
    Next
    For X = 30 To 30
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    Reg30.Text = Format(Reg30.Text, "dd/mm/yyyy")
    cNum = 38
    For X = 31 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    For X = 39 To 39
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
   Reg39.Text = Format(Reg39.Text, "dd/mm/yyyy")
       cNum = 61
    For X = 40 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
        For X = 62 To 62
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
      Reg62.Text = Format(Reg62.Text, "dd/mm/yyyy")
       cNum = 73
    For X = 63 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
       For X = 74 To 74
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg74.Text = Format(Reg74.Text, "dd/mm/yyyy")
    For X = 75 To 75
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
            For X = 76 To 76
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg76.Text = Format(Reg76.Text, "dd/mm/yyyy")
        For X = 77 To 77
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 78 To 78
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg78.Text = Format(Reg78.Text, "dd/mm/yyyy")
        For X = 79 To 79
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 80 To 80
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg80.Text = Format(Reg80.Text, "dd/mm/yyyy")
        For X = 81 To 81
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 82 To 82
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg82.Text = Format(Reg82.Text, "dd/mm/yyyy")
        For X = 83 To 83
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 84 To 84
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg84.Text = Format(Reg84.Text, "dd/mm/yyyy")
        For X = 85 To 85
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 86 To 86
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg86.Text = Format(Reg86.Text, "dd/mm/yyyy")
        For X = 87 To 87
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 88 To 88
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
    Reg88.Text = Format(Reg88.Text, "dd/mm/yyyy")
        For X = 89 To 89
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 90 To 90
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg90.Text = Format(Reg90.Text, "dd/mm/yyyy")
        For X = 91 To 91
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 92 To 92
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg92.Text = Format(Reg92.Text, "dd/mm/yyyy")
        For X = 93 To 93
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 94 To 94
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg94.Text = Format(Reg94.Text, "dd/mm/yyyy")
        For X = 95 To 95
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 96 To 96
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg96.Text = Format(Reg96.Text, "dd/mm/yyyy")
        For X = 97 To 97
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 98 To 98
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg98.Text = Format(Reg98.Text, "dd/mm/yyyy")
        For X = 99 To 99
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 100 To 100
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg100.Text = Format(Reg100.Text, "dd/mm/yyyy")
        For X = 101 To 101
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 102 To 102
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg102.Text = Format(Reg102.Text, "dd/mm/yyyy")
        For X = 103 To 103
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
        For X = 104 To 104
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
        Next
     Reg104.Text = Format(Reg104.Text, "dd/mm/yyyy")
    'disable adding
    Me.cmdAdd.Enabled = False
    Me.cmdEdit.Enabled = True
    'training due?
    If IsDate(Reg80.Text) Then
If CDate(Reg80.Text) < Date Then
 MsgBox "Training 2 Overdue - Please Check The Training Tab"
 End If
End If
If IsDate(Reg76.Text) Then
If CDate(Reg76.Text) < Date Then
 MsgBox "Training 1 Overdue - Please Check The Training Tab"
 End If
End If

    '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

Edit or Update Command Button below:

Private Sub cmdEdit_Click()
'declare the variables
    Dim findvalue As Range
    'error handling
    On Error GoTo ErrHandler:
            cmdEdit.BackColor = vbWhite
    cmdEdit.ForeColor = vbBlack
  Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
    'check for values
    If Reg4.value = "" Or Reg3.value = "" Then
        MsgBox "There is not data to edit"
        Exit Sub
    End If
    'edit the row
    Set findvalue = Sheet2.Range("mytable[Payroll_Number]").Find(What:=Reg1, LookIn:=xlValues).Offset(0, 0)
    'if the edit is a name then add it
    Me.Reg5.value = Me.Reg4.value + " " + Me.Reg3.value
    
    cNum = 108
    For X = 1 To cNum
        Me.Controls("Reg" & X).Text = findvalue
        Set findvalue = findvalue.Offset(0, 1)
    Next
    
    'refresh the listbox
    Lookup
    'error block
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
    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

 

[jasonb75]

As far as I can see most, if not all of those extra For x= .... Next loops are not actually doing anything other than repeating tasks (slowing it down) and making it harder to find the error.

I've just been over the thread again and I'm still not 100% sure what is supposed to be happening and where it is going wrong.

As far as I can tell, date is copied from sheet to form, changed in the form, then copied back to the sheet.
At which point in that process is the format being changed?

 

[HPFruity]

As far as I can see most, if not all of those extra For x= .... Next loops are not actually doing anything other than repeating tasks (slowing it down) and making it harder to find the error.

I've just been over the thread again and I'm still not 100% sure what is supposed to be happening and where it is going wrong.

As far as I can tell, date is copied from sheet to form, changed in the form, then copied back to the sheet.
At which point in that process is the format being changed?

It changes when the Userform picks up the data from the worksheet. I have just tried adding a date picker userform and seems to be working and I am now stuck trying to make the list box show the date as dd/mm/yyyy now. If I can get

The list box code is below:

    Sub Lookup()
'declare the variables
    Dim rngFind As Range
    Dim strFirstFind As String
    'error statement
    On Error GoTo ErrHandler:
    'clear the listbox
    lstLookup.Clear
    'look up parts or all of full mname
    With Sheet2.Range("mytable[Formal_Name]")
        Set rngFind = .Find(txtLookup.Text, LookIn:=xlValues, lookat:=xlPart)
        'if value found then set a variable for the address
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            'add the values to the listbox
            Do
                If rngFind.Row > 1 Then
                    lstLookup.AddItem rngFind.Text
                    lstLookup.List(lstLookup.ListCount - 1, 1) = rngFind.Offset(0, -4)
                    lstLookup.List(lstLookup.ListCount - 1, 2) = rngFind.Offset(0, 3)
                    lstLookup.List(lstLookup.ListCount - 1, 3) = rngFind.Offset(0, 4)
                    lstLookup.List(lstLookup.ListCount - 1, 4) = rngFind.Offset(0, 5) 'need to make this line appear as dd/mm/yyyy, currently is the only part of the problem now
                    lstLookup.List(lstLookup.ListCount - 1, 5) = rngFind.Offset(0, 7)
                    lstLookup.List(lstLookup.ListCount - 1, 6) = rngFind.Offset(0, 8)
                    lstLookup.List(lstLookup.ListCount - 1, 7) = rngFind.Offset(0, 9)
                    lstLookup.List(lstLookup.ListCount - 1, 8) = rngFind.Offset(0, 104)
                End If
                'find the next address to add
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
    'disable payroll editing
    Me.Reg1.Enabled = False
    Me.cmdEdit.Enabled = False
    '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

 

[HPFruity]

I mean't to say 'If I can get this now working everything else works fine now. Using another Userform to select the date in a locked textbox seems to work but just need the list box to show dd/mm/yyyy now